KIDS Distribution saved on May 26, 2020@14:01:09
Final release of Multi-Tenancy
**KIDS**:SAMI 18.0T05^

**INSTALL NAME**
SAMI 18.0T05
"BLD",10490,0)
SAMI 18.0T05^SAMI^0^3200526^n
"BLD",10490,1,0)
^^1^1^3200402^
"BLD",10490,1,1,0)
SAMI SITE FILE, PRINT TEMPLATE AND PRINT OPTION
"BLD",10490,4,0)
^9.64PA^311.11^3
"BLD",10490,4,311.11,0)
311.11
"BLD",10490,4,311.11,222)
y^y^f^^n^^y^o^n
"BLD",10490,4,311.12,0)
311.12
"BLD",10490,4,311.12,222)
y^y^f^^^^n^^
"BLD",10490,4,311.12,224)

"BLD",10490,4,311.13,0)
311.13
"BLD",10490,4,311.13,222)
y^y^f^^^^n
"BLD",10490,4,"B",311.11,311.11)

"BLD",10490,4,"B",311.12,311.12)

"BLD",10490,4,"B",311.13,311.13)

"BLD",10490,6.3)
12
"BLD",10490,"INID")
^n
"BLD",10490,"INIT")
UPGRADE^SAMISITE
"BLD",10490,"KRN",0)
^9.67PA^779.2^20
"BLD",10490,"KRN",.4,0)
.4
"BLD",10490,"KRN",.4,"NM",0)
^9.68A^2^2
"BLD",10490,"KRN",.4,"NM",1,0)
SAMI SITE USER MAP    FILE #311.12^311.12^0
"BLD",10490,"KRN",.4,"NM",2,0)
SAMI LIST SITES    FILE #311.12^311.12^0
"BLD",10490,"KRN",.4,"NM","B","SAMI LIST SITES    FILE #311.12",2)

"BLD",10490,"KRN",.4,"NM","B","SAMI SITE USER MAP    FILE #311.12",1)

"BLD",10490,"KRN",.401,0)
.401
"BLD",10490,"KRN",.401,"NM",0)
^9.68A^2^2
"BLD",10490,"KRN",.401,"NM",1,0)
SAMI SITE USER SORT    FILE #311.12^311.12^0
"BLD",10490,"KRN",.401,"NM",2,0)
SAMI SORT SITES    FILE #311.12^311.12^0
"BLD",10490,"KRN",.401,"NM","B","SAMI SITE USER SORT    FILE #311.12",1)

"BLD",10490,"KRN",.401,"NM","B","SAMI SORT SITES    FILE #311.12",2)

"BLD",10490,"KRN",.402,0)
.402
"BLD",10490,"KRN",.402,"NM",0)
^9.68A^3^3
"BLD",10490,"KRN",.402,"NM",1,0)
SAMI ENTER/EDIT SITE    FILE #311.12^311.12^0
"BLD",10490,"KRN",.402,"NM",2,0)
SAMI SUPERUSER ENTER/EDIT    FILE #311.13^311.13^0
"BLD",10490,"KRN",.402,"NM",3,0)
SAMI SITE ACTIVATE DEACTIVATE    FILE #311.12^311.12^0
"BLD",10490,"KRN",.402,"NM","B","SAMI ENTER/EDIT SITE    FILE #311.12",1)

"BLD",10490,"KRN",.402,"NM","B","SAMI SITE ACTIVATE DEACTIVATE    FILE #311.12",3)

"BLD",10490,"KRN",.402,"NM","B","SAMI SUPERUSER ENTER/EDIT    FILE #311.13",2)

"BLD",10490,"KRN",.403,0)
.403
"BLD",10490,"KRN",.5,0)
.5
"BLD",10490,"KRN",.84,0)
.84
"BLD",10490,"KRN",3.6,0)
3.6
"BLD",10490,"KRN",3.8,0)
3.8
"BLD",10490,"KRN",9.2,0)
9.2
"BLD",10490,"KRN",9.8,0)
9.8
"BLD",10490,"KRN",9.8,"NM",0)
^9.68A^13^13
"BLD",10490,"KRN",9.8,"NM",1,0)
SAMIFORM^^0^B4892541
"BLD",10490,"KRN",9.8,"NM",2,0)
SAMIFWS^^0^B13804779
"BLD",10490,"KRN",9.8,"NM",3,0)
SAMIHOM3^^0^B133868845
"BLD",10490,"KRN",9.8,"NM",4,0)
SAMIHOM4^^0^B565172253
"BLD",10490,"KRN",9.8,"NM",5,0)
SAMIPTLK^^0^B10220412
"BLD",10490,"KRN",9.8,"NM",6,0)
SAMISRC2^^0^B10574823
"BLD",10490,"KRN",9.8,"NM",7,0)
SAMICAS2^^0^B375024495
"BLD",10490,"KRN",9.8,"NM",8,0)
SAMIFLD^^0^B200769481
"BLD",10490,"KRN",9.8,"NM",9,0)
SAMISITE^^0^B64280616
"BLD",10490,"KRN",9.8,"NM",10,0)
SAMISAV^^0^B22601784
"BLD",10490,"KRN",9.8,"NM",11,0)
SAMIUR^^0^B110568961
"BLD",10490,"KRN",9.8,"NM",12,0)
SAMIUR1^^0^B58855507
"BLD",10490,"KRN",9.8,"NM",13,0)
SAMIUR2^^0^B369867052
"BLD",10490,"KRN",9.8,"NM","B","SAMICAS2",7)

"BLD",10490,"KRN",9.8,"NM","B","SAMIFLD",8)

"BLD",10490,"KRN",9.8,"NM","B","SAMIFORM",1)

"BLD",10490,"KRN",9.8,"NM","B","SAMIFWS",2)

"BLD",10490,"KRN",9.8,"NM","B","SAMIHOM3",3)

"BLD",10490,"KRN",9.8,"NM","B","SAMIHOM4",4)

"BLD",10490,"KRN",9.8,"NM","B","SAMIPTLK",5)

"BLD",10490,"KRN",9.8,"NM","B","SAMISAV",10)

"BLD",10490,"KRN",9.8,"NM","B","SAMISITE",9)

"BLD",10490,"KRN",9.8,"NM","B","SAMISRC2",6)

"BLD",10490,"KRN",9.8,"NM","B","SAMIUR",11)

"BLD",10490,"KRN",9.8,"NM","B","SAMIUR1",12)

"BLD",10490,"KRN",9.8,"NM","B","SAMIUR2",13)

"BLD",10490,"KRN",19,0)
19
"BLD",10490,"KRN",19,"NM",0)
^9.68A^8^8
"BLD",10490,"KRN",19,"NM",1,0)
SAMI SITE USER MAP^^0
"BLD",10490,"KRN",19,"NM",2,0)
SAMI MAIN MENU^^0
"BLD",10490,"KRN",19,"NM",3,0)
SAMI SITE AND USER MENU^^0
"BLD",10490,"KRN",19,"NM",4,0)
SAMI SUPERUSER ENTER/EDIT^^0
"BLD",10490,"KRN",19,"NM",5,0)
SAMI USER^^0
"BLD",10490,"KRN",19,"NM",6,0)
SAMI ENTER EDIT SITE^^0
"BLD",10490,"KRN",19,"NM",7,0)
SAMI LIST SITES^^0
"BLD",10490,"KRN",19,"NM",8,0)
SAMI ACTIVATE DEACTIVATE SITE^^0
"BLD",10490,"KRN",19,"NM","B","SAMI ACTIVATE DEACTIVATE SITE",8)

"BLD",10490,"KRN",19,"NM","B","SAMI ENTER EDIT SITE",6)

"BLD",10490,"KRN",19,"NM","B","SAMI LIST SITES",7)

"BLD",10490,"KRN",19,"NM","B","SAMI MAIN MENU",2)

"BLD",10490,"KRN",19,"NM","B","SAMI SITE AND USER MENU",3)

"BLD",10490,"KRN",19,"NM","B","SAMI SITE USER MAP",1)

"BLD",10490,"KRN",19,"NM","B","SAMI SUPERUSER ENTER/EDIT",4)

"BLD",10490,"KRN",19,"NM","B","SAMI USER",5)

"BLD",10490,"KRN",19.1,0)
19.1
"BLD",10490,"KRN",101,0)
101
"BLD",10490,"KRN",409.61,0)
409.61
"BLD",10490,"KRN",771,0)
771
"BLD",10490,"KRN",779.2,0)
779.2
"BLD",10490,"KRN",870,0)
870
"BLD",10490,"KRN",8989.51,0)
8989.51
"BLD",10490,"KRN",8989.52,0)
8989.52
"BLD",10490,"KRN",8994,0)
8994
"BLD",10490,"KRN","B",.4,.4)

"BLD",10490,"KRN","B",.401,.401)

"BLD",10490,"KRN","B",.402,.402)

"BLD",10490,"KRN","B",.403,.403)

"BLD",10490,"KRN","B",.5,.5)

"BLD",10490,"KRN","B",.84,.84)

"BLD",10490,"KRN","B",3.6,3.6)

"BLD",10490,"KRN","B",3.8,3.8)

"BLD",10490,"KRN","B",9.2,9.2)

"BLD",10490,"KRN","B",9.8,9.8)

"BLD",10490,"KRN","B",19,19)

"BLD",10490,"KRN","B",19.1,19.1)

"BLD",10490,"KRN","B",101,101)

"BLD",10490,"KRN","B",409.61,409.61)

"BLD",10490,"KRN","B",771,771)

"BLD",10490,"KRN","B",779.2,779.2)

"BLD",10490,"KRN","B",870,870)

"BLD",10490,"KRN","B",8989.51,8989.51)

"BLD",10490,"KRN","B",8989.52,8989.52)

"BLD",10490,"KRN","B",8994,8994)

"DATA",311.11,10,0)
casereview
"DATA",311.11,10,2)
^Case Review List.html
"DATA",311.11,11,0)
sbform3^^8
"DATA",311.11,11,2)
^background.html
"DATA",311.11,12,0)
home
"DATA",311.11,12,2)
^Home.html
"DATA",311.11,13,0)
nuform
"DATA",311.11,13,2)
^New Form.html
"DATA",311.11,14,0)
vapals:casereview
"DATA",311.11,14,2)
^casereview.html
"DATA",311.11,15,0)
vapals:ceform
"DATA",311.11,15,2)
^ctevaluation.html
"DATA",311.11,16,0)
vapals:home
"DATA",311.11,16,2)
^home.html
"DATA",311.11,17,0)
vapals:sbform
"DATA",311.11,17,2)
^background.html
"DATA",311.11,18,0)
vapals:siform
"DATA",311.11,18,2)
^intake.html
"DATA",311.11,19,0)
vapals:nuform
"DATA",311.11,19,2)
^newform.html
"DATA",311.11,20,0)
vapals:fuform
"DATA",311.11,20,2)
^followup.html
"DATA",311.11,21,0)
vapals:ptform
"DATA",311.11,21,2)
^pet.html
"DATA",311.11,22,0)
vapals:bxform
"DATA",311.11,22,2)
^biopsy.html
"DATA",311.11,24,0)
vapals:home2b
"DATA",311.11,24,2)
STUDY ID^home2b.html
"DATA",311.11,25,0)
vapals:itform
"DATA",311.11,25,2)
^intervention.html
"DATA",311.11,26,0)
vapals:note
"DATA",311.11,26,2)
^report.html
"DATA",311.11,27,0)
bxform
"DATA",311.11,27,2)
^Biopsy_Mediastinoscopy Form.html
"DATA",311.11,28,0)
ceform
"DATA",311.11,28,2)
^CT Evaluation Form.html
"DATA",311.11,29,0)
fuform
"DATA",311.11,29,2)
^Follow-up Form.html
"DATA",311.11,30,0)
ptform
"DATA",311.11,30,2)
^PET Evaluation Form.html
"DATA",311.11,31,0)
rbform
"DATA",311.11,31,2)
^Intervention and Treatment Form.html
"DATA",311.11,32,0)
sbform2
"DATA",311.11,32,2)
^Background Form.html
"DATA",311.11,33,0)
siform
"DATA",311.11,33,2)
^Intake Form.html
"DATA",311.11,34,0)
sintake
"DATA",311.11,34,2)
^Schedule Contact.html
"DATA",311.11,35,0)
vapals:addperson
"DATA",311.11,35,2)
^register.html
"DATA",311.11,36,0)
vapals:editparticipant
"DATA",311.11,36,2)
^editparticipant.html
"DATA",311.11,37,0)
vapals:syserror
"DATA",311.11,37,2)
^error.html
"DATA",311.11,38,0)
vapals:login
"DATA",311.11,38,2)
^login.html
"DATA",311.11,39,0)
vapals:siteselect
"DATA",311.11,39,2)
^blank_no_nav.html
"FIA",311.11)
SAMI FORM MAPPING
"FIA",311.11,0)
^SAMI(311.11,
"FIA",311.11,0,0)
311.11
"FIA",311.11,0,1)
y^y^f^^n^^y^o^n
"FIA",311.11,0,10)

"FIA",311.11,0,11)

"FIA",311.11,0,"RLRO")

"FIA",311.11,0,"VR")
18.0T05^SAMI
"FIA",311.11,311.11)
0
"FIA",311.11,311.11001)
0
"FIA",311.12)
SAMI SITE
"FIA",311.12,0)
^SAMI(311.12,
"FIA",311.12,0,0)
311.12PI
"FIA",311.12,0,1)
y^y^f^^^^n^^
"FIA",311.12,0,10)

"FIA",311.12,0,11)

"FIA",311.12,0,"RLRO")

"FIA",311.12,0,"VR")
18.0T05^SAMI
"FIA",311.12,311.12)
0
"FIA",311.13)
SAMI SUPERUSERS
"FIA",311.13,0)
^SAMI(311.13,
"FIA",311.13,0,0)
311.13P
"FIA",311.13,0,1)
y^y^f^^^^n
"FIA",311.13,0,10)

"FIA",311.13,0,11)

"FIA",311.13,0,"RLRO")

"FIA",311.13,0,"VR")
18.0T05^SAMI
"FIA",311.13,311.13)
0
"INIT")
UPGRADE^SAMISITE
"IX",311.11,311.11,"D",0)
311.11^D^Select variables by DD # & field #^R^^R^IR^W^311.11001^^^^^LS
"IX",311.11,311.11,"D",1)
S ^SAMI(311.11,"D",X(1),X(2),DA(1),DA)=""
"IX",311.11,311.11,"D",2)
K ^SAMI(311.11,"D",X(1),X(2),DA(1),DA)
"IX",311.11,311.11,"D",2.5)
K ^SAMI(311.11,"D")
"IX",311.11,311.11,"D",11.1,0)
^.114IA^2^2
"IX",311.11,311.11,"D",11.1,1,0)
1^F^311.11001^.5^^1^F
"IX",311.11,311.11,"D",11.1,1,3)

"IX",311.11,311.11,"D",11.1,2,0)
2^F^311.11001^1^^2^F
"IX",311.11,311.11,"D",11.1,2,3)

"IX",311.12,311.12,"SYM",0)
311.12^SYM^REGULAR XREF ON THE SYMBOL FIELD^R^^F^IR^I^311.12^^^^^LS
"IX",311.12,311.12,"SYM",1)
S ^SAMI(311.12,"SYM",$E(X,1,3),DA)=""
"IX",311.12,311.12,"SYM",2)
K ^SAMI(311.12,"SYM",$E(X,1,3),DA)
"IX",311.12,311.12,"SYM",2.5)
K ^SAMI(311.12,"SYM")
"IX",311.12,311.12,"SYM",11.1,0)
^.114IA^1^1
"IX",311.12,311.12,"SYM",11.1,1,0)
1^F^311.12^.02^3^1^F
"KRN",.4,1562,-1)
0^1
"KRN",.4,1562,0)
SAMI SITE USER MAP^3200325.2047^@^311.12^^@^3200510
"KRN",.4,1562,"DXS",1,9)
S I(0,0)=$G(D0),DIP(1)=$S($D(^SAMI(311.12,D0,0)):^(0),1:""),D0=$P(DIP(1),U,1) S:'D0!'$D(^DIC(4,+D0,0)) D0=-1 S D0=D0 S I(100,0)=$G(D0) X DXS(1,9.4) S X="" S D0=I(0,0)
"KRN",.4,1562,"DXS",1,9.2)
S Y(9.1,201)=$S($D(^VA(200,D0,0)):^(0),1:"") S X=$P(Y(9.1,201),U,1)
"KRN",.4,1562,"DXS",1,9.3)
S (D,D0)=$QS(DIMQ,$QL(DIMQ)-1) I D,$D(^VA(200,D,0)) S X=$P(^(0),U)  X DXS(1,9.2) X DICMX
"KRN",.4,1562,"DXS",1,9.4)
N DIMQ,DIMSTRT,DIMSCNT S (DIMQ,DIMSTRT)=$NA(^VA(200,"AH",I(100,0))),DIMSCNT=$QL(DIMQ) F  S DIMQ=$Q(@DIMQ) Q:DIMQ=""  Q:$NA(@DIMQ,DIMSCNT)'=DIMSTRT   X DXS(1,9.3) Q:'$D(D)  S D=D0
"KRN",.4,1562,"F",2)
X DXS(1,9) W X K DIP;m;Z;".01:NEW PERSON:NAME"~
"KRN",.4,1562,"H")
SAMI SITE List
"KRN",.4,1563,-1)
0^2
"KRN",.4,1563,0)
SAMI LIST SITES^3200420.1429^@^311.12^^@^3200420
"KRN",.4,1563,"F",2)
.01;J1L40~.02;J42L4~.03;J48L5~
"KRN",.4,1563,"H")
SAMI SITE List
"KRN",.401,934,-1)
0^1
"KRN",.401,934,0)
SAMI SITE USER SORT^3200325.205^@^311.12^^@^3200510
"KRN",.401,934,2,0)
^.4014^1^1
"KRN",.401,934,2,1,0)
311.12^^SITE^".01^^^^^^4
"KRN",.401,934,2,1,"CM")
S Y(1)=$S($D(^SAMI(311.12,D0,0)):^(0),1:"") S X=$P($G(^DIC(4,+$P(Y(1),U,1),0)),U) I D0>0 S DISX(1)=X
"KRN",.401,934,2,1,"GET")
S Y(1)=$S($D(^SAMI(311.12,D0,0)):^(0),1:"") S X=$P($G(^DIC(4,+$P(Y(1),U,1),0)),U) I D0>0 S DISX(1)=X
"KRN",.401,934,2,1,"IX")
^SAMI(311.12,"B",^SAMI(311.12,^2
"KRN",.401,934,2,1,"PTRIX")
^DIC(4,"B",
"KRN",.401,934,2,1,"QCON")
I DISX(1)'=""
"KRN",.401,934,2,1,"SER")
0.0000^0.0000
"KRN",.401,934,2,1,"TXT")
 SITE not null
"KRN",.401,934,2,"B",311.12,1)

"KRN",.401,935,-1)
0^2
"KRN",.401,935,0)
SAMI SORT SITES^3200420.1428^@^311.12^^@^3200420
"KRN",.401,935,2,0)
^.4014^1^1
"KRN",.401,935,2,1,0)
311.12^^SITE^".01^^^^^^4
"KRN",.401,935,2,1,"CM")
S Y(1)=$S($D(^SAMI(311.12,D0,0)):^(0),1:"") S X=$P($G(^DIC(4,+$P(Y(1),U,1),0)),U) I D0>0 S DISX(1)=X
"KRN",.401,935,2,1,"GET")
S Y(1)=$S($D(^SAMI(311.12,D0,0)):^(0),1:"") S X=$P($G(^DIC(4,+$P(Y(1),U,1),0)),U) I D0>0 S DISX(1)=X
"KRN",.401,935,2,1,"IX")
^SAMI(311.12,"B",^SAMI(311.12,^2
"KRN",.401,935,2,1,"PTRIX")
^DIC(4,"B",
"KRN",.401,935,2,1,"QCON")
I DISX(1)'=""
"KRN",.401,935,2,1,"SER")
0.0000^0.0000
"KRN",.401,935,2,1,"TXT")
 SITE not null
"KRN",.401,935,2,"B",311.12,1)

"KRN",.402,1797,-1)
0^1
"KRN",.402,1797,0)
SAMI ENTER/EDIT SITE^3200410.1752^@^311.12^^@^3200410
"KRN",.402,1797,"DIAB",1,0,311.12,0)
ALL
"KRN",.402,1797,"DR",1,311.12)
.01:.03
"KRN",.402,1798,-1)
0^2
"KRN",.402,1798,0)
SAMI SUPERUSER ENTER/EDIT^3200410.1819^@^311.13^^@^3200410
"KRN",.402,1798,"DIAB",1,0,311.13,0)
ALL
"KRN",.402,1798,"DR",1,311.13)
.01:.02
"KRN",.402,1799,-1)
0^3
"KRN",.402,1799,0)
SAMI SITE ACTIVATE DEACTIVATE^3200420.15^@^311.12^^@^3200420
"KRN",.402,1799,"DR",1,311.12)
.03;
"KRN",19,11804,-1)
0^1
"KRN",19,11804,0)
SAMI SITE USER MAP^SITE USER MAP^^P^^^^^^^^SAMI
"KRN",19,11804,1,0)
^19.06^1^1^3200325^^
"KRN",19,11804,1,1,0)
PRINTS THE MAP OF SITES AND USERS ASSIGNED TO EACH SITE
"KRN",19,11804,60)
SAMI(311.12,
"KRN",19,11804,62)
0
"KRN",19,11804,63)
[SAMI SITE USER MAP]
"KRN",19,11804,64)
[SAMI SITE USER SORT]
"KRN",19,11804,65)

"KRN",19,11804,66)

"KRN",19,11804,"U")
SITE USER MAP
"KRN",19,11805,-1)
0^5
"KRN",19,11805,0)
SAMI USER^SAMI USER CONTEXT^^B^^^^^^^^SAMI
"KRN",19,11805,1,0)
^^1^1^3200325^
"KRN",19,11805,1,1,0)
USER CONTEXT FOR SAMI VAPALS-ELCAP APPLICATIONS
"KRN",19,11805,99.1)
65488,84064
"KRN",19,11805,"U")
SAMI USER CONTEXT
"KRN",19,11806,-1)
0^6
"KRN",19,11806,0)
SAMI ENTER EDIT SITE^ENTER EDIT SITE^^E^^^^^^^^SAMI
"KRN",19,11806,1,0)
^19.06^1^1^3200419^^^
"KRN",19,11806,1,1,0)
CREATE OR EDIT VAPALS SITE
"KRN",19,11806,30)
SAMI(311.12,
"KRN",19,11806,31)
AEMQL
"KRN",19,11806,50)
SAMI(311.12,
"KRN",19,11806,51)
[SAMI ENTER/EDIT SITE]
"KRN",19,11806,"U")
ENTER EDIT SITE
"KRN",19,11807,-1)
0^3
"KRN",19,11807,0)
SAMI SITE AND USER MENU^SITE AND USER MENU^^M^^^^^^^^SAMI
"KRN",19,11807,1,0)
^19.06^1^1^3200420^^^^
"KRN",19,11807,1,1,0)
MENU OF SITE AND USER MANAGEMENT OPTIONS
"KRN",19,11807,10,0)
^19.01IP^7^6
"KRN",19,11807,10,2,0)
11804^SI
"KRN",19,11807,10,2,"^")
SAMI SITE USER MAP
"KRN",19,11807,10,5,0)
11806^SE
"KRN",19,11807,10,5,"^")
SAMI ENTER EDIT SITE
"KRN",19,11807,10,6,0)
11810^LI
"KRN",19,11807,10,6,"^")
SAMI LIST SITES
"KRN",19,11807,10,7,0)
11811^AC
"KRN",19,11807,10,7,"^")
SAMI ACTIVATE DEACTIVATE SITE
"KRN",19,11807,99)
65489,54205
"KRN",19,11807,"U")
SITE AND USER MENU
"KRN",19,11808,-1)
0^2
"KRN",19,11808,0)
SAMI MAIN MENU^SAMI MAIN MENU^^M^^^^^^^^SAMI
"KRN",19,11808,1,0)
^^1^1^3200410^
"KRN",19,11808,1,1,0)
MAIN MENU OF ADMIN OPTIONS FOR VAPALS
"KRN",19,11808,10,0)
^19.01IP^1^1
"KRN",19,11808,10,1,0)
11807^SI
"KRN",19,11808,10,1,"^")
SAMI SITE AND USER MENU
"KRN",19,11808,99)
65479,65438
"KRN",19,11808,"U")
SAMI MAIN MENU
"KRN",19,11809,-1)
0^4
"KRN",19,11809,0)
SAMI SUPERUSER ENTER/EDIT^SUPERUSER ENTER/EDIT^^E^^^^^^^^SAMI
"KRN",19,11809,1,0)
^^2^2^3200410^
"KRN",19,11809,1,1,0)
ENTER/EDIT
"KRN",19,11809,1,2,0)
SUPERUSER FILE
"KRN",19,11809,30)
SAMI(311.13,
"KRN",19,11809,31)
AEMQL
"KRN",19,11809,50)
SAMI(311.13,
"KRN",19,11809,51)
[SAMI SUPERUSER ENTER/EDIT]
"KRN",19,11809,"U")
SUPERUSER ENTER/EDIT
"KRN",19,11810,-1)
0^7
"KRN",19,11810,0)
SAMI LIST SITES^LIST SITES^^P^^^^^^^^SAMI
"KRN",19,11810,60)
SAMI(311.12,
"KRN",19,11810,62)
0
"KRN",19,11810,63)
[SAMI LIST SITES]
"KRN",19,11810,64)
[SAMI SORT SITES]
"KRN",19,11810,65)

"KRN",19,11810,66)

"KRN",19,11810,"U")
LIST SITES
"KRN",19,11811,-1)
0^8
"KRN",19,11811,0)
SAMI ACTIVATE DEACTIVATE SITE^ACTIVATE DEACTIVATE SITE^^E^^^^^^^^SAMI
"KRN",19,11811,1,0)
^^1^1^3200420^
"KRN",19,11811,1,1,0)
OPTION TO MARK A SITE ACTIVE OR INACTIVE
"KRN",19,11811,30)
SAMI(311.12,
"KRN",19,11811,31)
AEMQ
"KRN",19,11811,50)
SAMI(311.12,
"KRN",19,11811,51)
[SAMI SITE ACTIVATE DEACTIVATE]
"KRN",19,11811,"U")
ACTIVATE DEACTIVATE SITE
"MBREQ")
0
"ORD",5,.4)
.4;5;;;EDEOUT^DIFROMSO(.4,DA,"",XPDA);FPRE^DIFROMSI(.4,"",XPDA);EPRE^DIFROMSI(.4,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.4,DA,"",XPDA);DEL^DIFROMSK(.4,"",%)
"ORD",5,.4,0)
PRINT TEMPLATE
"ORD",6,.401)
.401;6;;;EDEOUT^DIFROMSO(.401,DA,"",XPDA);FPRE^DIFROMSI(.401,"",XPDA);EPRE^DIFROMSI(.401,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.401,DA,"",XPDA);DEL^DIFROMSK(.401,"",%)
"ORD",6,.401,0)
SORT TEMPLATE
"ORD",7,.402)
.402;7;;;EDEOUT^DIFROMSO(.402,DA,"",XPDA);FPRE^DIFROMSI(.402,"",XPDA);EPRE^DIFROMSI(.402,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.402,DA,"",XPDA);DEL^DIFROMSK(.402,"",%)
"ORD",7,.402,0)
INPUT TEMPLATE
"ORD",18,19)
19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA
"ORD",18,19,0)
OPTION
"PKG",230,-1)
1^1
"PKG",230,0)
SAMI^SAMI^SCREENING APPLICATIONS MANAGEMENT - IELCAP
"PKG",230,5)
VEN
"PKG",230,20,0)
^9.402P^^
"PKG",230,22,0)
^9.49I^1^1
"PKG",230,22,1,0)
18.0T05^3200526
"PKG",230,22,1,1,0)
^^1^1^3200526
"PKG",230,22,1,1,1,0)
SAMI SITE FILE, PRINT TEMPLATE AND PRINT OPTION
"PKG",230,"VERSION")
18.0T05
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
13
"RTN","SAMICAS2")
0^7^B375024495
"RTN","SAMICAS2",1,0)
SAMICAS2 ;ven/gpl - ielcap: case review page ; 2019-08-01T15:42Z
"RTN","SAMICAS2",2,0)
 ;;18.0;SAM;;;Build 12
"RTN","SAMICAS2",3,0)
 ;
"RTN","SAMICAS2",4,0)
 ;@license: see routine SAMIUL
"RTN","SAMICAS2",5,0)
 ;
"RTN","SAMICAS2",6,0)
 ;@documentation : see SAMICUL
"RTN","SAMICAS2",7,0)
 ;
"RTN","SAMICAS2",8,0)
 ;@contents
"RTN","SAMICAS2",9,0)
 ; wsCASE: generate case review page
"RTN","SAMICAS2",10,0)
 ; $$GETDTKEY = date part of form key
"RTN","SAMICAS2",11,0)
 ; $$KEY2DSPD = date in elcap format from key date
"RTN","SAMICAS2",12,0)
 ; GETTMPL: return html template
"RTN","SAMICAS2",13,0)
 ; GETITEMS: get items available for studyid
"RTN","SAMICAS2",14,0)
 ;
"RTN","SAMICAS2",15,0)
 ; wsNuForm: select a new form for patient (get service)
"RTN","SAMICAS2",16,0)
 ; wsNuFormPost: post new form selection (post service)
"RTN","SAMICAS2",17,0)
 ; MKCEFORM: create ct evaluation form
"RTN","SAMICAS2",18,0)
 ;
"RTN","SAMICAS2",19,0)
 ; casetbl: generate case review table
"RTN","SAMICAS2",20,0)
 ;
"RTN","SAMICAS2",21,0)
 ;
"RTN","SAMICAS2",22,0)
 ;
"RTN","SAMICAS2",23,0)
 ;@section 1 wsCASE & related ppis
"RTN","SAMICAS2",24,0)
 ;
"RTN","SAMICAS2",25,0)
 ;
"RTN","SAMICAS2",26,0)
 ;@ppi - generate case review page
"RTN","SAMICAS2",27,0)
WSCASE ; generate case review page
"RTN","SAMICAS2",28,0)
 ;
"RTN","SAMICAS2",29,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMICAS2",30,0)
 ;
"RTN","SAMICAS2",31,0)
 ;ven/gpl;web service;procedure;
"RTN","SAMICAS2",32,0)
 ;@web service
"RTN","SAMICAS2",33,0)
 ; SAMICASE-wsCASE
"RTN","SAMICAS2",34,0)
 ;@called by :
"RTN","SAMICAS2",35,0)
 ; WSCASE^SAMICASE
"RTN","SAMICAS2",36,0)
 ; _wfhform
"RTN","SAMICAS2",37,0)
 ; %wfhform
"RTN","SAMICAS2",38,0)
 ;@calls :
"RTN","SAMICAS2",39,0)
 ; $$setroot^%wd
"RTN","SAMICAS2",40,0)
 ; GETTMPL^SAMICAS2
"RTN","SAMICAS2",41,0)
 ; GETITEMS^SAMICASE
"RTN","SAMICAS2",42,0)
 ; $$SID2NUM^SAMIHOM3
"RTN","SAMICAS2",43,0)
 ; findReplace^%ts
"RTN","SAMICAS2",44,0)
 ; FIXHREF^SAMIFORM
"RTN","SAMICAS2",45,0)
 ; FIXSRC^SAMIFORM
"RTN","SAMICAS2",46,0)
 ; $$GETDTKEY^SAMICAS2
"RTN","SAMICAS2",47,0)
 ; $$KEY2DSPD^SAMICAS2
"RTN","SAMICAS2",48,0)
 ; $$GETLAST5^SAMIFORM
"RTN","SAMICAS2",49,0)
 ; $$GETSSN^SAMIFORM
"RTN","SAMICAS2",50,0)
 ; $$GETNAME^SAMIFORM
"RTN","SAMICAS2",51,0)
 ; $$GSAMISTA^SAMICAS2
"RTN","SAMICAS2",52,0)
 ; D ADDCRLF^VPRJRUT
"RTN","SAMICAS2",53,0)
 ;@input :
"RTN","SAMICAS2",54,0)
 ; .filter =
"RTN","SAMICAS2",55,0)
 ; .filter("studyid")=studyid of the patient
"RTN","SAMICAS2",56,0)
 ;@output :
"RTN","SAMICAS2",57,0)
 ; .rtn
"RTN","SAMICAS2",58,0)
 ;@tests :
"RTN","SAMICAS2",59,0)
 ; SAMIUTS2
"RTN","SAMICAS2",60,0)
 ;
"RTN","SAMICAS2",61,0)
 ;@stanza 2 initialize
"RTN","SAMICAS2",62,0)
 ;
"RTN","SAMICAS2",63,0)
 kill rtn
"RTN","SAMICAS2",64,0)
 ;
"RTN","SAMICAS2",65,0)
 new groot set groot=$$setroot^%wd("vapals-patients") ; root of patient graphs
"RTN","SAMICAS2",66,0)
 ;
"RTN","SAMICAS2",67,0)
 new temp ; html template
"RTN","SAMICAS2",68,0)
 do GETTMPL^SAMICASE("temp","vapals:casereview")
"RTN","SAMICAS2",69,0)
 quit:'$data(temp)
"RTN","SAMICAS2",70,0)
 ;
"RTN","SAMICAS2",71,0)
 new sid set sid=$get(filter("studyid"))
"RTN","SAMICAS2",72,0)
 if sid="" set sid=$get(filter("studyId"))
"RTN","SAMICAS2",73,0)
 if sid="" set sid=$get(filter("fvalue"))
"RTN","SAMICAS2",74,0)
 quit:sid=""
"RTN","SAMICAS2",75,0)
 ;
"RTN","SAMICAS2",76,0)
 new items
"RTN","SAMICAS2",77,0)
 do GETITEMS^SAMICASE("items",sid)
"RTN","SAMICAS2",78,0)
 quit:'$data(items)
"RTN","SAMICAS2",79,0)
 ;
"RTN","SAMICAS2",80,0)
 new gien set gien=$$SID2NUM^SAMIHOM3(sid) ; graph ien
"RTN","SAMICAS2",81,0)
 new name set name=$get(@groot@(gien,"saminame"))
"RTN","SAMICAS2",82,0)
 quit:name=""
"RTN","SAMICAS2",83,0)
 new fname set fname=$piece(name,",",2)
"RTN","SAMICAS2",84,0)
 new lname set lname=$piece(name,",")
"RTN","SAMICAS2",85,0)
 ;
"RTN","SAMICAS2",86,0)
 ;@stanza 3 change resource paths to /see/
"RTN","SAMICAS2",87,0)
 ;
"RTN","SAMICAS2",88,0)
 new cnt set cnt=0
"RTN","SAMICAS2",89,0)
 new zi set zi=0
"RTN","SAMICAS2",90,0)
 ;for  set zi=$order(temp(zi)) quit:+zi=0  quit:temp(zi)["VEP0001"  do  ;
"RTN","SAMICAS2",91,0)
 for  set zi=$order(temp(zi)) quit:+zi=0  quit:temp(zi)["tbody"  do  ;
"RTN","SAMICAS2",92,0)
 . new ln set ln=temp(zi)
"RTN","SAMICAS2",93,0)
 . new touched set touched=0
"RTN","SAMICAS2",94,0)
 . ;
"RTN","SAMICAS2",95,0)
 . if ln["@@SITE@@" do  ; insert site id
"RTN","SAMICAS2",96,0)
 . . n siteid s siteid=$g(filter("siteid"))
"RTN","SAMICAS2",97,0)
 . . i siteid="" s siteid=$g(filter("site"))
"RTN","SAMICAS2",98,0)
 . . q:siteid=""
"RTN","SAMICAS2",99,0)
 . . do findReplace^%ts(.ln,"@@SITE@@",siteid)
"RTN","SAMICAS2",100,0)
 . . s temp(zi)=ln
"RTN","SAMICAS2",101,0)
 . ;
"RTN","SAMICAS2",102,0)
 . if ln["@@SITETITLE@@" do  ; insert site title
"RTN","SAMICAS2",103,0)
 . . n sitetit s sitetit=$g(filter("sitetitle"))
"RTN","SAMICAS2",104,0)
 . . if sitetit="" d  ;
"RTN","SAMICAS2",105,0)
 . . . n tsite s tsite=$g(filter("site"))
"RTN","SAMICAS2",106,0)
 . . . q:tsite=""
"RTN","SAMICAS2",107,0)
 . . . s sitetit=$$SITENM2^SAMISITE(tsite)_" - "_tsite
"RTN","SAMICAS2",108,0)
 . . q:sitetit=""
"RTN","SAMICAS2",109,0)
 . . do findReplace^%ts(.ln,"@@SITETITLE@@",sitetit)
"RTN","SAMICAS2",110,0)
 . . s temp(zi)=ln
"RTN","SAMICAS2",111,0)
 . ;
"RTN","SAMICAS2",112,0)
 . if ln["id" if ln["studyIdMenu" do  ;
"RTN","SAMICAS2",113,0)
 . . set zi=zi+4
"RTN","SAMICAS2",114,0)
 . ;
"RTN","SAMICAS2",115,0)
 . if ln["home.html" do  ;
"RTN","SAMICAS2",116,0)
 . . do findReplace^%ts(.ln,"home.html","/vapals")
"RTN","SAMICAS2",117,0)
 . . set temp(zi)=ln
"RTN","SAMICAS2",118,0)
 . . set touched=1
"RTN","SAMICAS2",119,0)
 . ;
"RTN","SAMICAS2",120,0)
 . if ln["href" if 'touched do  ;
"RTN","SAMICAS2",121,0)
 . . do FIXHREF^SAMIFORM(.ln)
"RTN","SAMICAS2",122,0)
 . . set temp(zi)=ln
"RTN","SAMICAS2",123,0)
 . ;
"RTN","SAMICAS2",124,0)
 . if ln["src" do  ;
"RTN","SAMICAS2",125,0)
 . . do FIXSRC^SAMIFORM(.ln)
"RTN","SAMICAS2",126,0)
 . . set temp(zi)=ln
"RTN","SAMICAS2",127,0)
 . ;
"RTN","SAMICAS2",128,0)
 . set cnt=cnt+1
"RTN","SAMICAS2",129,0)
 . set rtn(cnt)=temp(zi)
"RTN","SAMICAS2",130,0)
 . quit
"RTN","SAMICAS2",131,0)
 ;
"RTN","SAMICAS2",132,0)
 ; ready to insert rows for selection
"RTN","SAMICAS2",133,0)
 ;
"RTN","SAMICAS2",134,0)
 ;@stanza 4 intake form
"RTN","SAMICAS2",135,0)
 ;
"RTN","SAMICAS2",136,0)
 new sikey set sikey=$order(items("sifor"))
"RTN","SAMICAS2",137,0)
 if sikey="" set sikey="siform-2017-12-10"
"RTN","SAMICAS2",138,0)
 new sidate set sidate=$$GETDTKEY(sikey)
"RTN","SAMICAS2",139,0)
 set sikey="vapals:"_sikey
"RTN","SAMICAS2",140,0)
 new sidispdate set sidispdate=$$KEY2DSPD(sidate)
"RTN","SAMICAS2",141,0)
 ;new geturl set geturl="/form?form=vapals:siform&studyid="_sid_"&key="_sikey
"RTN","SAMICAS2",142,0)
 new nuhref set nuhref="<form method=POST action=""/vapals"">"
"RTN","SAMICAS2",143,0)
 set nuhref=nuhref_"<td><input type=hidden name=""samiroute"" value=""nuform"">"
"RTN","SAMICAS2",144,0)
 set nuhref=nuhref_"<input type=hidden name=""studyid"" value="_sid_">"
"RTN","SAMICAS2",145,0)
 set nuhref=nuhref_"<input value=""New Form"" class=""btn label label-warning"" role=""link"" type=""submit""></form></td>"
"RTN","SAMICAS2",146,0)
 ; new intake notes table
"RTN","SAMICAS2",147,0)
 n notehref,form
"RTN","SAMICAS2",148,0)
 set form=$p(sikey,":",2)
"RTN","SAMICAS2",149,0)
 set notehref=$$NOTEHREF^SAMICASE(sid,form) ; table of notes
"RTN","SAMICAS2",150,0)
 set cnt=cnt+1
"RTN","SAMICAS2",151,0)
 ;new facilitycode set facilitycode=$$GETPRFX^SAMIFORM()
"RTN","SAMICAS2",152,0)
 n siteid s siteid=$g(filter("siteid"))
"RTN","SAMICAS2",153,0)
 i siteid="" s siteid=$g(filter("site"))
"RTN","SAMICAS2",154,0)
 new facilitycode set facilitycode=siteid
"RTN","SAMICAS2",155,0)
 new last5 set last5=$$GETLAST5^SAMIFORM(sid)
"RTN","SAMICAS2",156,0)
 new pssn set pssn=$$GETSSN^SAMIFORM(sid)
"RTN","SAMICAS2",157,0)
 new pname set pname=$$GETNAME^SAMIFORM(sid)
"RTN","SAMICAS2",158,0)
 new useid set useid=pssn
"RTN","SAMICAS2",159,0)
 if useid="" set useid=last5
"RTN","SAMICAS2",160,0)
 set rtn(cnt)="<tr><td> "_useid_" </td><td> "_pname_" </td><td> "_facilitycode_" </td><td>"_sidispdate_"</td><td>"_$char(13)
"RTN","SAMICAS2",161,0)
 set cnt=cnt+1
"RTN","SAMICAS2",162,0)
 set rtn(cnt)="<form method=""post"" action=""/vapals"">"
"RTN","SAMICAS2",163,0)
 set cnt=cnt+1
"RTN","SAMICAS2",164,0)
 set rtn(cnt)="<input name=""samiroute"" value=""form"" type=""hidden"">"
"RTN","SAMICAS2",165,0)
 set rtn(cnt)=rtn(cnt)_" <input name=""studyid"" value="""_sid_""" type=""hidden"">"
"RTN","SAMICAS2",166,0)
 set rtn(cnt)=rtn(cnt)_" <input name=""form"" value="""_sikey_""" type=""hidden"">"
"RTN","SAMICAS2",167,0)
 set rtn(cnt)=rtn(cnt)_" <input value=""Intake"" class=""btn btn-link"" role=""link"" type=""submit"">"
"RTN","SAMICAS2",168,0)
 ;
"RTN","SAMICAS2",169,0)
 new samistatus set samistatus=""
"RTN","SAMICAS2",170,0)
 if $$GSAMISTA(sid,sikey)="incomplete" set samistatus="(incomplete)"
"RTN","SAMICAS2",171,0)
 set cnt=cnt+1
"RTN","SAMICAS2",172,0)
 set rtn(cnt)="</form>"_samistatus_notehref_"</td>"_$char(13)
"RTN","SAMICAS2",173,0)
 set cnt=cnt+1
"RTN","SAMICAS2",174,0)
 set rtn(cnt)=nuhref_"</tr>"
"RTN","SAMICAS2",175,0)
 ;
"RTN","SAMICAS2",176,0)
 ;@stanza 6 rest of the forms
"RTN","SAMICAS2",177,0)
 ;
"RTN","SAMICAS2",178,0)
 new zj set zj="" ; each of the rest of the forms
"RTN","SAMICAS2",179,0)
 if $data(items("sort")) do  ; we have more forms
"RTN","SAMICAS2",180,0)
 . for  set zj=$order(items("sort",zj)) quit:zj=""  do  ;
"RTN","SAMICAS2",181,0)
 . . new cdate set cdate=zj
"RTN","SAMICAS2",182,0)
 . . new zk set zk=""
"RTN","SAMICAS2",183,0)
 . . for  set zk=$order(items("sort",cdate,zk)) q:zk=""  do  ;
"RTN","SAMICAS2",184,0)
 . . . new zform set zform=zk
"RTN","SAMICAS2",185,0)
 . . . new zkey set zkey=$order(items("sort",cdate,zform,""))
"RTN","SAMICAS2",186,0)
 . . . new zname set zname=$order(items("sort",cdate,zform,zkey,""))
"RTN","SAMICAS2",187,0)
 . . . new dispdate set dispdate=$$KEY2DSPD(cdate)
"RTN","SAMICAS2",188,0)
 . . . set zform="vapals:"_zkey ; all the new forms are vapals:key
"RTN","SAMICAS2",189,0)
 . . . ;new geturl set geturl="/form?form="_zform_"&studyid="_sid_"&key="_zkey
"RTN","SAMICAS2",190,0)
 . . . set cnt=cnt+1
"RTN","SAMICAS2",191,0)
 . . . ;set rtn(cnt)="<tr><td> "_sid_" </td><td> - </td><td> - </td><td> - </td><td>"_dispdate_"</td><td>"
"RTN","SAMICAS2",192,0)
 . . . set rtn(cnt)="<tr><td> "_useid_" </td><td> - </td><td> - </td><td>"_dispdate_"</td><td>"
"RTN","SAMICAS2",193,0)
 . . . set cnt=cnt+1
"RTN","SAMICAS2",194,0)
 . . . set rtn(cnt)="<form method=""post"" action=""/vapals"">"_$char(13)
"RTN","SAMICAS2",195,0)
 . . . set cnt=cnt+1
"RTN","SAMICAS2",196,0)
 . . . set rtn(cnt)="<input name=""samiroute"" value=""form"" type=""hidden"">"_$char(13)
"RTN","SAMICAS2",197,0)
 . . . set cnt=cnt+1
"RTN","SAMICAS2",198,0)
 . . . set rtn(cnt)=" <input name=""studyid"" value="""_sid_""" type=""hidden"">"_$char(13)
"RTN","SAMICAS2",199,0)
 . . . set cnt=cnt+1
"RTN","SAMICAS2",200,0)
 . . . set rtn(cnt)=" <input name=""form"" value="""_zform_""" type=""hidden"">"_$char(13)
"RTN","SAMICAS2",201,0)
 . . . set cnt=cnt+1
"RTN","SAMICAS2",202,0)
 . . . set rtn(cnt)=" <input value="""_zname_""" class=""btn btn-link"" role=""link"" type=""submit"">"_$char(13)
"RTN","SAMICAS2",203,0)
 . . . ;
"RTN","SAMICAS2",204,0)
 . . . new samistatus set samistatus=""
"RTN","SAMICAS2",205,0)
 . . . if $$GSAMISTA(sid,zform)="incomplete" set samistatus="(incomplete)"
"RTN","SAMICAS2",206,0)
 . . . set cnt=cnt+1
"RTN","SAMICAS2",207,0)
 . . . set rtn(cnt)="</form>"_samistatus_$$NOTEHREF^SAMICASE(sid,zkey)_"</td>"
"RTN","SAMICAS2",208,0)
 . . . set cnt=cnt+1
"RTN","SAMICAS2",209,0)
 . . . if zform["ceform" do  ;
"RTN","SAMICAS2",210,0)
 . . . . new rpthref set rpthref="<form method=POST action=""/vapals"">"
"RTN","SAMICAS2",211,0)
 . . . . set rpthref=rpthref_"<td><input type=hidden name=""samiroute"" value=""ctreport"">"
"RTN","SAMICAS2",212,0)
 . . . . set rpthref=rpthref_"<input type=hidden name=""form"" value="_$p(zform,":",2)_">"
"RTN","SAMICAS2",213,0)
 . . . . set rpthref=rpthref_"<input type=hidden name=""studyid"" value="_sid_">"
"RTN","SAMICAS2",214,0)
 . . . . set rpthref=rpthref_"<input value=""Report"" class=""btn label label-warning"" role=""link"" type=""submit""></form></td>"
"RTN","SAMICAS2",215,0)
 . . . . set rtn(cnt)=rpthref_"</tr>"
"RTN","SAMICAS2",216,0)
 . . . . ;set rtn(cnt)="</tr>" ; turn off report
"RTN","SAMICAS2",217,0)
 . . . else  set rtn(cnt)="<td></td></tr>"
"RTN","SAMICAS2",218,0)
 . . . quit
"RTN","SAMICAS2",219,0)
 . . quit
"RTN","SAMICAS2",220,0)
 . quit
"RTN","SAMICAS2",221,0)
 ;
"RTN","SAMICAS2",222,0)
 ;
"RTN","SAMICAS2",223,0)
 ;@stanza 7 skip ahead in template to tbody
"RTN","SAMICAS2",224,0)
 ;
"RTN","SAMICAS2",225,0)
 new loc set loc=zi+1
"RTN","SAMICAS2",226,0)
 for  set zi=$order(temp(zi)) quit:+zi=0  quit:temp(zi)["/tbody"  do  ;
"RTN","SAMICAS2",227,0)
 . set x=$get(x)
"RTN","SAMICAS2",228,0)
 . quit
"RTN","SAMICAS2",229,0)
 set zi=zi-1
"RTN","SAMICAS2",230,0)
 ;
"RTN","SAMICAS2",231,0)
 ;@stanza 8 rest of lines
"RTN","SAMICAS2",232,0)
 ;
"RTN","SAMICAS2",233,0)
 for  set zi=$order(temp(zi)) quit:+zi=0  do  ;
"RTN","SAMICAS2",234,0)
 . new line
"RTN","SAMICAS2",235,0)
 . set line=temp(zi)
"RTN","SAMICAS2",236,0)
 . ;
"RTN","SAMICAS2",237,0)
 . if line["@@SITE@@" do  ; insert site id
"RTN","SAMICAS2",238,0)
 . . n siteid s siteid=$g(filter("siteid"))
"RTN","SAMICAS2",239,0)
 . . i siteid="" s siteid=$g(filter("site"))
"RTN","SAMICAS2",240,0)
 . . q:siteid=""
"RTN","SAMICAS2",241,0)
 . . do findReplace^%ts(.line,"@@SITE@@",siteid)
"RTN","SAMICAS2",242,0)
 . ;
"RTN","SAMICAS2",243,0)
 . if line["@@SITETITLE@@" do  ; insert site title
"RTN","SAMICAS2",244,0)
 . . n sitetit s sitetit=$g(filter("sitetitle"))
"RTN","SAMICAS2",245,0)
 . . if sitetit="" d  ;
"RTN","SAMICAS2",246,0)
 . . . n tsite s tsite=$g(filter("site"))
"RTN","SAMICAS2",247,0)
 . . . q:tsite=""
"RTN","SAMICAS2",248,0)
 . . . s sitetit=$$SITENM2^SAMISITE(tsite)_" - "_tsite
"RTN","SAMICAS2",249,0)
 . . q:sitetit=""
"RTN","SAMICAS2",250,0)
 . . do findReplace^%ts(.line,"@@SITETITLE@@",sitetit)
"RTN","SAMICAS2",251,0)
 . ;
"RTN","SAMICAS2",252,0)
 . if line["XX0002" do  ;
"RTN","SAMICAS2",253,0)
 . . do findReplace^%ts(.line,"XX0002",sid)
"RTN","SAMICAS2",254,0)
 . ;
"RTN","SAMICAS2",255,0)
 . if line["@@ERROR_MESSAGE@@" do ;
"RTN","SAMICAS2",256,0)
 . . n zerr
"RTN","SAMICAS2",257,0)
 . . k ^gpl("error")
"RTN","SAMICAS2",258,0)
 . . m ^gpl("error")=filter
"RTN","SAMICAS2",259,0)
 . . s zerr=$g(filter("errorMessage"))
"RTN","SAMICAS2",260,0)
 . . ;i err="" q  ;
"RTN","SAMICAS2",261,0)
 . . s ^gpl("error","zerr")=zerr
"RTN","SAMICAS2",262,0)
 . . do findReplace^%ts(.line,"@@ERROR_MESSAGE@@",zerr)
"RTN","SAMICAS2",263,0)
 . . s ^gpl("error","newline")=line
"RTN","SAMICAS2",264,0)
 . set cnt=cnt+1
"RTN","SAMICAS2",265,0)
 . set rtn(cnt)=line
"RTN","SAMICAS2",266,0)
 . quit
"RTN","SAMICAS2",267,0)
 ;
"RTN","SAMICAS2",268,0)
 do ADDCRLF^VPRJRUT(.rtn)
"RTN","SAMICAS2",269,0)
 set HTTPRSP("mime")="text/html" ; set mime type
"RTN","SAMICAS2",270,0)
 ;
"RTN","SAMICAS2",271,0)
 ;@stanza 9 termination
"RTN","SAMICAS2",272,0)
 ;
"RTN","SAMICAS2",273,0)
 quit  ; end of wsCASE
"RTN","SAMICAS2",274,0)
 ;
"RTN","SAMICAS2",275,0)
 ;@ppi NOTHREF
"RTN","SAMICAS2",276,0)
NOTEHREF ; extrinsic returns html for the list of notes for the form
"RTN","SAMICAS2",277,0)
 n notehref,ntlist
"RTN","SAMICAS2",278,0)
 s notehref=""
"RTN","SAMICAS2",279,0)
 i form["sifor" d NTLIST^SAMINOT1("ntlist",sid,form)
"RTN","SAMICAS2",280,0)
 i form["fufor" d NTLIST^SAMINOT2("ntlist",sid,form)
"RTN","SAMICAS2",281,0)
 i $o(ntlist(""))="" q notehref
"RTN","SAMICAS2",282,0)
 set notehref="<table>"
"RTN","SAMICAS2",283,0)
 n zi
"RTN","SAMICAS2",284,0)
 s zi=0
"RTN","SAMICAS2",285,0)
 f  s zi=$o(ntlist(zi)) q:+zi=0  d  ;
"RTN","SAMICAS2",286,0)
 . set notehref=notehref_"<td><form method=POST action=""/vapals"">"
"RTN","SAMICAS2",287,0)
 . set notehref=notehref_"<input type=hidden name=""nien"" value="""_$g(ntlist(zi,"nien"))_""">"
"RTN","SAMICAS2",288,0)
 . set notehref=notehref_"<input type=hidden name=""samiroute"" value=""note"">"
"RTN","SAMICAS2",289,0)
 . set notehref=notehref_"<input type=hidden name=""studyid"" value="_sid_">"
"RTN","SAMICAS2",290,0)
 . set notehref=notehref_"<input type=hidden name=""form"" value="_form_">"
"RTN","SAMICAS2",291,0)
 . set notehref=notehref_"<input value="""_$g(ntlist(zi,"name"))_""" class=""btn btn-link"" role=""link"" type=""submit""></form></td></tr>"
"RTN","SAMICAS2",292,0)
 set notehref=notehref_"</table>"
"RTN","SAMICAS2",293,0)
 q notehref
"RTN","SAMICAS2",294,0)
 ;
"RTN","SAMICAS2",295,0)
 ;@ppi - get html template
"RTN","SAMICAS2",296,0)
GETTMPL ; get html template
"RTN","SAMICAS2",297,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMICAS2",298,0)
 ;
"RTN","SAMICAS2",299,0)
 ;ven/gpl;private;procedure;
"RTN","SAMICAS2",300,0)
 ;@called-by
"RTN","SAMICAS2",301,0)
 ; GETTMPL^SAMICASE
"RTN","SAMICAS2",302,0)
 ;@calls
"RTN","SAMICAS2",303,0)
 ; $$getTemplate^%wf
"RTN","SAMICAS2",304,0)
 ; getThis^%wd
"RTN","SAMICAS2",305,0)
 ;@input
"RTN","SAMICAS2",306,0)
 ; return = name of array to return template in
"RTN","SAMICAS2",307,0)
 ; form = name of form
"RTN","SAMICAS2",308,0)
 ;@output
"RTN","SAMICAS2",309,0)
 ; @return = template
"RTN","SAMICAS2",310,0)
 ;@examples [tbd]
"RTN","SAMICAS2",311,0)
 ;@tests [tbd]
"RTN","SAMICAS2",312,0)
 ;
"RTN","SAMICAS2",313,0)
 ;@stanza 2 get html template
"RTN","SAMICAS2",314,0)
 ;
"RTN","SAMICAS2",315,0)
 quit:$get(form)=""
"RTN","SAMICAS2",316,0)
 ;
"RTN","SAMICAS2",317,0)
 new fn set fn=$$getTemplate^%wf(form)
"RTN","SAMICAS2",318,0)
 do getThis^%wd(return,fn)
"RTN","SAMICAS2",319,0)
 ;
"RTN","SAMICAS2",320,0)
 set HTTPRSP("mime")="text/html"
"RTN","SAMICAS2",321,0)
 ;
"RTN","SAMICAS2",322,0)
 ;@stanza 3 termination
"RTN","SAMICAS2",323,0)
 ;
"RTN","SAMICAS2",324,0)
 quit  ; end of GETTMPL
"RTN","SAMICAS2",325,0)
 ;
"RTN","SAMICAS2",326,0)
 ;
"RTN","SAMICAS2",327,0)
CNTITEMS(sid) ; extrinsic returns how many forms the patient has
"RTN","SAMICAS2",328,0)
 ; used before deleting a patient
"RTN","SAMICAS2",329,0)
 ;@called by : none
"RTN","SAMICAS2",330,0)
 ;@calls :
"RTN","SAMICAS2",331,0)
 ; $$setroot^%wd
"RTN","SAMICAS2",332,0)
 ;@input ;
"RTN","SAMICAS2",333,0)
 ; sid = patient's study ID (e.g. "XXX00001")
"RTN","SAMICAS2",334,0)
 ;@output ;
"RTN","SAMICAS2",335,0)
 ;@tests :
"RTN","SAMICAS2",336,0)
 ; SAMIUTS2
"RTN","SAMICAS2",337,0)
 new groot set groot=$$setroot^%wd("vapals-patients")
"RTN","SAMICAS2",338,0)
 quit:'$data(@groot@("graph",sid)) 0  ; nothing there
"RTN","SAMICAS2",339,0)
 new cnt,zi
"RTN","SAMICAS2",340,0)
 set zi=""
"RTN","SAMICAS2",341,0)
 set cnt=0
"RTN","SAMICAS2",342,0)
 for  set zi=$o(@groot@("graph",sid,zi)) quit:zi=""  do  ;
"RTN","SAMICAS2",343,0)
 . set cnt=cnt+1
"RTN","SAMICAS2",344,0)
 quit cnt
"RTN","SAMICAS2",345,0)
 ;
"RTN","SAMICAS2",346,0)
 ;@ppi - get items available for studyid
"RTN","SAMICAS2",347,0)
GETITEMS ; get items available for studyid
"RTN","SAMICAS2",348,0)
 ;
"RTN","SAMICAS2",349,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMICAS2",350,0)
 ;
"RTN","SAMICAS2",351,0)
 ;ven/gpl;private;procedure;
"RTN","SAMICAS2",352,0)
 ;@called by
"RTN","SAMICAS2",353,0)
 ; GETITEMS^SAMICASE
"RTN","SAMICAS2",354,0)
 ;@calls
"RTN","SAMICAS2",355,0)
 ; $$setroot^%wd
"RTN","SAMICAS2",356,0)
 ;@input
"RTN","SAMICAS2",357,0)
 ; @ary = returned items available
"RTN","SAMICAS2",358,0)
 ; sid = patient's study ID (e.g. "XXX00001")
"RTN","SAMICAS2",359,0)
 ;@output
"RTN","SAMICAS2",360,0)
 ;@tests
"RTN","SAMICAS2",361,0)
 ; SAMIUTS2
"RTN","SAMICAS2",362,0)
 ;
"RTN","SAMICAS2",363,0)
 ;@stanza 2 get items
"RTN","SAMICAS2",364,0)
 ;
"RTN","SAMICAS2",365,0)
 new groot set groot=$$setroot^%wd("vapals-patients")
"RTN","SAMICAS2",366,0)
 quit:'$data(@groot@("graph",sid))  ; nothing there
"RTN","SAMICAS2",367,0)
 ;
"RTN","SAMICAS2",368,0)
 kill @ary
"RTN","SAMICAS2",369,0)
 new zi set zi=""
"RTN","SAMICAS2",370,0)
 for  set zi=$order(@groot@("graph",sid,zi)) quit:zi=""  do  ;
"RTN","SAMICAS2",371,0)
 . set @ary@(zi)=""
"RTN","SAMICAS2",372,0)
 . quit
"RTN","SAMICAS2",373,0)
 ;
"RTN","SAMICAS2",374,0)
 ;@stanza 3 get rest of forms (many-to-one, get dates)
"RTN","SAMICAS2",375,0)
 ;
"RTN","SAMICAS2",376,0)
 new tary
"RTN","SAMICAS2",377,0)
 for  set zi=$order(@ary@(zi)) quit:zi=""  do  ;
"RTN","SAMICAS2",378,0)
 . new zkey1,zform set zkey1=$piece(zi,"-",1)
"RTN","SAMICAS2",379,0)
 . ;if zkey1="sbform" quit  ;
"RTN","SAMICAS2",380,0)
 . if zkey1="siform" quit  ;
"RTN","SAMICAS2",381,0)
 . new fname
"RTN","SAMICAS2",382,0)
 . if zkey1="ceform" set fname="CT Evaluation"
"RTN","SAMICAS2",383,0)
 . set zform=zkey1
"RTN","SAMICAS2",384,0)
 . if zkey1="sbform" set zform="vapals:sbform"
"RTN","SAMICAS2",385,0)
 . if zkey1="sbform" set fname="Background"
"RTN","SAMICAS2",386,0)
 . if zkey1="ceform" set zform="vapals:ceform"
"RTN","SAMICAS2",387,0)
 . if zkey1="fuform" set zform="vapals:fuform"
"RTN","SAMICAS2",388,0)
 . if zkey1="fuform" set fname="Follow-up"
"RTN","SAMICAS2",389,0)
 . if zkey1="bxform" set fname="Biopsy"
"RTN","SAMICAS2",390,0)
 . if zkey1="bxform" set zform="vapals:bxform"
"RTN","SAMICAS2",391,0)
 . if zkey1="ptform" set zform="vapals:ptform"
"RTN","SAMICAS2",392,0)
 . if zkey1="ptform" set fname="PET Evaluation"
"RTN","SAMICAS2",393,0)
 . if zkey1="itform" set zform="vapals:itform"
"RTN","SAMICAS2",394,0)
 . if zkey1="itform" set fname="Intervention"
"RTN","SAMICAS2",395,0)
 . if $get(fname)="" set fname="unknown"
"RTN","SAMICAS2",396,0)
 . new zdate set zdate=$extract(zi,$length(zkey1)+2,$length(zi))
"RTN","SAMICAS2",397,0)
 . quit:$get(zdate)=""
"RTN","SAMICAS2",398,0)
 . quit:$get(zform)=""
"RTN","SAMICAS2",399,0)
 . quit:$get(zi)=""
"RTN","SAMICAS2",400,0)
 . quit:$get(fname)=""
"RTN","SAMICAS2",401,0)
 . set tary("sort",zdate,zform,zi,fname)=""
"RTN","SAMICAS2",402,0)
 . set tary("type",zform,zi,fname)=""
"RTN","SAMICAS2",403,0)
 . quit
"RTN","SAMICAS2",404,0)
 merge @ary=tary
"RTN","SAMICAS2",405,0)
 ;
"RTN","SAMICAS2",406,0)
 ;@stanza 4 termination
"RTN","SAMICAS2",407,0)
 ;
"RTN","SAMICAS2",408,0)
 quit  ; end of GETITEMS
"RTN","SAMICAS2",409,0)
 ;
"RTN","SAMICAS2",410,0)
 ;
"RTN","SAMICAS2",411,0)
 ;
"RTN","SAMICAS2",412,0)
GETDTKEY(formid) ; date portion of form key
"RTN","SAMICAS2",413,0)
 ;
"RTN","SAMICAS2",414,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMICAS2",415,0)
 ;
"RTN","SAMICAS2",416,0)
 ;ven/gpl;private;function;
"RTN","SAMICAS2",417,0)
 ;@called by
"RTN","SAMICAS2",418,0)
 ;  WSCASE^SAMICAS2
"RTN","SAMICAS2",419,0)
 ;@calls :
"RTN","SAMICAS2",420,0)
 ;@input
"RTN","SAMICAS2",421,0)
 ; formid form key
"RTN","SAMICAS2",422,0)
 ;@output
"RTN","SAMICAS2",423,0)
 ; date from form key
"RTN","SAMICAS2",424,0)
 ;@examples
"RTN","SAMICAS2",425,0)
 ; $$GETDTKEY("sbform-2018-02-26") = "2018-02-26"
"RTN","SAMICAS2",426,0)
 ;@tests :
"RTN","SAMICAS2",427,0)
 ; SAMIUTS2
"RTN","SAMICAS2",428,0)
 ;
"RTN","SAMICAS2",429,0)
 ;@stanza 2 calculate date from key
"RTN","SAMICAS2",430,0)
 ;
"RTN","SAMICAS2",431,0)
 new frm set frm=$piece(formid,"-")
"RTN","SAMICAS2",432,0)
 new date set date=$piece(formid,frm_"-",2)
"RTN","SAMICAS2",433,0)
 ;
"RTN","SAMICAS2",434,0)
 ;@stanza 3 return & termination
"RTN","SAMICAS2",435,0)
 ;
"RTN","SAMICAS2",436,0)
 quit date ; return date; end of $$GETDTKEY
"RTN","SAMICAS2",437,0)
 ;
"RTN","SAMICAS2",438,0)
 ;
"RTN","SAMICAS2",439,0)
 ;
"RTN","SAMICAS2",440,0)
KEY2DSPD(zkey) ; date in elcap format from key date
"RTN","SAMICAS2",441,0)
 ;
"RTN","SAMICAS2",442,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMICAS2",443,0)
 ;
"RTN","SAMICAS2",444,0)
 ;ven/gpl;private;function;
"RTN","SAMICAS2",445,0)
 ;@called by
"RTN","SAMICAS2",446,0)
 ;  WSCASE^SAMICAS2
"RTN","SAMICAS2",447,0)
 ;@calls
"RTN","SAMICAS2",448,0)
 ; ^%DT
"RTN","SAMICAS2",449,0)
 ; $$FMTE^XLFDT
"RTN","SAMICAS2",450,0)
 ; $$VAPALSDT^SAMICAS2
"RTN","SAMICAS2",451,0)
 ;@input
"RTN","SAMICAS2",452,0)
 ; zkey = date in any format %DT can process
"RTN","SAMICAS2",453,0)
 ;@output
"RTN","SAMICAS2",454,0)
 ; date in elcap format
"RTN","SAMICAS2",455,0)
 ;@examples
"RTN","SAMICAS2",456,0)
 ; date 2018-02-26 => 26/Feb/2018
"RTN","SAMICAS2",457,0)
 ;@tests
"RTN","SAMICAS2",458,0)
 ; SAMIUTS2
"RTN","SAMICAS2",459,0)
 ;
"RTN","SAMICAS2",460,0)
 ;@stanza 2 convert date to elcap display format
"RTN","SAMICAS2",461,0)
 ;
"RTN","SAMICAS2",462,0)
 new X set X=zkey
"RTN","SAMICAS2",463,0)
 new Y
"RTN","SAMICAS2",464,0)
 do ^%DT
"RTN","SAMICAS2",465,0)
 ;new Z set Z=$$FMTE^XLFDT(Y,"9D")
"RTN","SAMICAS2",466,0)
 ;set Z=$translate(Z," ","/")
"RTN","SAMICAS2",467,0)
 new zdate
"RTN","SAMICAS2",468,0)
 set zdate=$$VAPALSDT^SAMICASE(Y)
"RTN","SAMICAS2",469,0)
 ;
"RTN","SAMICAS2",470,0)
 ;@stanza 3 return & termination
"RTN","SAMICAS2",471,0)
 ;
"RTN","SAMICAS2",472,0)
 quit zdate  ; return date; end of $$keysdispDate
"RTN","SAMICAS2",473,0)
 ;
"RTN","SAMICAS2",474,0)
 ;
"RTN","SAMICAS2",475,0)
 ;@ppi - extrinsic which return the vapals format for dates
"RTN","SAMICAS2",476,0)
VAPALSDT ; extrinsic which return the vapals format for dates
"RTN","SAMICAS2",477,0)
 ; fmdate is the date in fileman format
"RTN","SAMICAS2",478,0)
 ;@called by
"RTN","SAMICAS2",479,0)
 ; VAPALSDT^SAMICASE
"RTN","SAMICAS2",480,0)
 ;@calls
"RTN","SAMICAS2",481,0)
 ; $$FMTE^XLFDT
"RTN","SAMICAS2",482,0)
 ;@input
"RTN","SAMICAS2",483,0)
 ; fmdate = date in fileman format
"RTN","SAMICAS2",484,0)
 ;@output
"RTN","SAMICAS2",485,0)
 ; vapals date format
"RTN","SAMICAS2",486,0)
 ;@tests
"RTN","SAMICAS2",487,0)
 ; SAMIUTS2
"RTN","SAMICAS2",488,0)
 ;
"RTN","SAMICAS2",489,0)
 ;new Z set Z=$$FMTE^XLFDT(fmdate,"9D")
"RTN","SAMICAS2",490,0)
 ;set Z=$translate(Z," ","/")
"RTN","SAMICAS2",491,0)
 new Z set Z=$$FMTE^XLFDT(fmdate,"5D")
"RTN","SAMICAS2",492,0)
 quit Z
"RTN","SAMICAS2",493,0)
 ;
"RTN","SAMICAS2",494,0)
 ;@section 2 wsNuForm, wsNuFormPost, & related ppis
"RTN","SAMICAS2",495,0)
 ;
"RTN","SAMICAS2",496,0)
 ;
"RTN","SAMICAS2",497,0)
 ;
"RTN","SAMICAS2",498,0)
WSNUFORM ; select new form for patient (get service)
"RTN","SAMICAS2",499,0)
 ;
"RTN","SAMICAS2",500,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMICAS2",501,0)
 ;
"RTN","SAMICAS2",502,0)
 ;ven/gpl;web service;procedure;
"RTN","SAMICAS2",503,0)
 ;@called by
"RTN","SAMICAS2",504,0)
 ; WSNUFORM^SAMICASE
"RTN","SAMICAS2",505,0)
 ;@web service
"RTN","SAMICAS2",506,0)
 ;  SAMICASE-wsNuForm
"RTN","SAMICAS2",507,0)
 ;@calls
"RTN","SAMICAS2",508,0)
 ; $$SID2NUM^SAMIHOM3
"RTN","SAMICAS2",509,0)
 ; $$setroot^%wd
"RTN","SAMICAS2",510,0)
 ; GETTMPL^SAMICAS2
"RTN","SAMICAS2",511,0)
 ; findReplace^%ts
"RTN","SAMICAS2",512,0)
 ; FIXHREF^SAMIFORM
"RTN","SAMICAS2",513,0)
 ; FIXSRC^SAMIFORM
"RTN","SAMICAS2",514,0)
 ; findReplace^%ts
"RTN","SAMICAS2",515,0)
 ;@input
"RTN","SAMICAS2",516,0)
 ; .filter =
"RTN","SAMICAS2",517,0)
 ; .filter("studyid")=studyid of the patient
"RTN","SAMICAS2",518,0)
 ;@output
"RTN","SAMICAS2",519,0)
 ; @rtn
"RTN","SAMICAS2",520,0)
 ;@tests
"RTN","SAMICAS2",521,0)
 ; SAMIUTS
"RTN","SAMICAS2",522,0)
 ;
"RTN","SAMICAS2",523,0)
 ;@stanza 2 get select-new-form form
"RTN","SAMICAS2",524,0)
 ;
"RTN","SAMICAS2",525,0)
 new sid set sid=$get(filter("studyid"))
"RTN","SAMICAS2",526,0)
 quit:sid=""
"RTN","SAMICAS2",527,0)
 new sien set sien=$$SID2NUM^SAMIHOM3(sid)
"RTN","SAMICAS2",528,0)
 quit:+sien=0
"RTN","SAMICAS2",529,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMICAS2",530,0)
 new groot set groot=$name(@root@(sien))
"RTN","SAMICAS2",531,0)
 ;
"RTN","SAMICAS2",532,0)
 new saminame set saminame=$get(@groot@("saminame"))
"RTN","SAMICAS2",533,0)
 quit:saminame=""
"RTN","SAMICAS2",534,0)
 ;
"RTN","SAMICAS2",535,0)
 new temp,tout,form
"RTN","SAMICAS2",536,0)
 set return="temp",form="vapals:nuform"
"RTN","SAMICAS2",537,0)
 do GETTMPL
"RTN","SAMICAS2",538,0)
 quit:'$data(temp)
"RTN","SAMICAS2",539,0)
 ;
"RTN","SAMICAS2",540,0)
 new cnt set cnt=0
"RTN","SAMICAS2",541,0)
 new zi set zi=0
"RTN","SAMICAS2",542,0)
 for  set zi=$order(temp(zi)) quit:+zi=0  do  ;
"RTN","SAMICAS2",543,0)
 . new ln set ln=temp(zi)
"RTN","SAMICAS2",544,0)
 . new touched set touched=0
"RTN","SAMICAS2",545,0)
 . ;
"RTN","SAMICAS2",546,0)
 . ;if ln["id" if ln["studyIdMenu" do  ;
"RTN","SAMICAS2",547,0)
 . ;. set zi=zi+4
"RTN","SAMICAS2",548,0)
 . ;
"RTN","SAMICAS2",549,0)
 . ;if ln["home.html" do  ;
"RTN","SAMICAS2",550,0)
 . ;. do findReplace^%ts(.ln,"home.html","/vapals")
"RTN","SAMICAS2",551,0)
 . ;. set temp(zi)=ln
"RTN","SAMICAS2",552,0)
 . ;. set touched=1
"RTN","SAMICAS2",553,0)
 . ;
"RTN","SAMICAS2",554,0)
 . if ln["href" if 'touched do  ;
"RTN","SAMICAS2",555,0)
 . . do FIXHREF^SAMIFORM(.ln)
"RTN","SAMICAS2",556,0)
 . . set temp(zi)=ln
"RTN","SAMICAS2",557,0)
 . ;
"RTN","SAMICAS2",558,0)
 . if ln["src" d  ;
"RTN","SAMICAS2",559,0)
 . . do FIXSRC^SAMIFORM(.ln)
"RTN","SAMICAS2",560,0)
 . . set temp(zi)=ln
"RTN","SAMICAS2",561,0)
 . ;
"RTN","SAMICAS2",562,0)
 . ;if ln["form" if ln["todo" do  ;
"RTN","SAMICAS2",563,0)
 . ;. do findReplace^%ts(.ln,"todo","/vapals")
"RTN","SAMICAS2",564,0)
 . ;. set cnt=cnt+1
"RTN","SAMICAS2",565,0)
 . ;. set rtn(cnt)=ln
"RTN","SAMICAS2",566,0)
 . ;. set cnt=cnt+1
"RTN","SAMICAS2",567,0)
 . ;. set rtn(cnt)="<input type=hidden name=""samiroute"" value=""addform"">"
"RTN","SAMICAS2",568,0)
 . ;. set cnt=cnt+1
"RTN","SAMICAS2",569,0)
 . ;. set rtn(cnt)="<input type=hidden name=""sid"" value="_sid_">"
"RTN","SAMICAS2",570,0)
 . ;. set zi=zi+1
"RTN","SAMICAS2",571,0)
 . ;
"RTN","SAMICAS2",572,0)
 . ;if ln["background" set temp(zi)=""
"RTN","SAMICAS2",573,0)
 . ;if ln["background" do  ;
"RTN","SAMICAS2",574,0)
 . ;. do findReplace^%ts(.ln,"background","sbform")
"RTN","SAMICAS2",575,0)
 . ;. set temp(zi)=ln
"RTN","SAMICAS2",576,0)
 . ;if ln["followup" do  ;
"RTN","SAMICAS2",577,0)
 . ;. do findReplace^%ts(.ln,"followup","fuform")
"RTN","SAMICAS2",578,0)
 . ;. set temp(zi)=ln
"RTN","SAMICAS2",579,0)
 . ;if ln["pet" do  ;
"RTN","SAMICAS2",580,0)
 . ;. do findReplace^%ts(.ln,"pet","ptform")
"RTN","SAMICAS2",581,0)
 . ;. set temp(zi)=ln
"RTN","SAMICAS2",582,0)
 . ;if ln["ctevaluation" do ;
"RTN","SAMICAS2",583,0)
 . ;. do findReplace^%ts(.ln,"ctevaluation","ceform")
"RTN","SAMICAS2",584,0)
 . ;. set temp(zi)=ln
"RTN","SAMICAS2",585,0)
 . ;if ln["biopsy" do  ;
"RTN","SAMICAS2",586,0)
 . ;. do findReplace^%ts(.ln,"biopsy","bxform")
"RTN","SAMICAS2",587,0)
 . ;. set temp(zi)=ln
"RTN","SAMICAS2",588,0)
 . ;if ln["newform" do  ;
"RTN","SAMICAS2",589,0)
 . ;. set temp(zi)=""
"RTN","SAMICAS2",590,0)
 . ;. set temp(zi+1)=""
"RTN","SAMICAS2",591,0)
 . ;
"RTN","SAMICAS2",592,0)
 . if ln["@@SID@@" do  ;
"RTN","SAMICAS2",593,0)
 . . do findReplace^%ts(.ln,"@@SID@@",sid)
"RTN","SAMICAS2",594,0)
 . . set temp(zi)=ln
"RTN","SAMICAS2",595,0)
 . . quit
"RTN","SAMICAS2",596,0)
 . ;
"RTN","SAMICAS2",597,0)
 . ;if ln["<script" if temp(zi+1)["function" do  ;
"RTN","SAMICAS2",598,0)
 . ;. set zi=$$SCANFOR^SAMIHOM3(.temp,zi,"</script")
"RTN","SAMICAS2",599,0)
 . ;. set zi=zi+1
"RTN","SAMICAS2",600,0)
 . ;
"RTN","SAMICAS2",601,0)
 . set cnt=cnt+1
"RTN","SAMICAS2",602,0)
 . set rtn(cnt)=temp(zi)
"RTN","SAMICAS2",603,0)
 ;
"RTN","SAMICAS2",604,0)
 ;merge tout=rtn
"RTN","SAMICAS2",605,0)
 ;do ADDCRLF^VPRJRUT(.tout)
"RTN","SAMICAS2",606,0)
 ;merge rtn=tout
"RTN","SAMICAS2",607,0)
 ;
"RTN","SAMICAS2",608,0)
 ;@stanza 3 termination
"RTN","SAMICAS2",609,0)
 ;
"RTN","SAMICAS2",610,0)
 quit  ; end of wsNuForm
"RTN","SAMICAS2",611,0)
 ;
"RTN","SAMICAS2",612,0)
 ;
"RTN","SAMICAS2",613,0)
 ;@ppi - convert a key to a fileman date
"RTN","SAMICAS2",614,0)
KEY2FM ; convert a key to a fileman date
"RTN","SAMICAS2",615,0)
 ;@called by
"RTN","SAMICAS2",616,0)
 ; SAVFILTR^SAMISAV
"RTN","SAMICAS2",617,0)
 ; SELECT^SAMIUR1
"RTN","SAMICAS2",618,0)
 ;@calls
"RTN","SAMICAS2",619,0)
 ; ^%DT
"RTN","SAMICAS2",620,0)
 ;@input
"RTN","SAMICAS2",621,0)
 ; key = vapals key (e.g.
"RTN","SAMICAS2",622,0)
 ;@output
"RTN","SAMICAS2",623,0)
 ;@examples
"RTN","SAMICAS2",624,0)
 ;  $$KEY2FM("sbform-2018-02-26") = 3180226
"RTN","SAMICAS2",625,0)
 ;@tests
"RTN","SAMICAS2",626,0)
 ; SAMIUTS2
"RTN","SAMICAS2",627,0)
 ;
"RTN","SAMICAS2",628,0)
 new datepart,X,Y,frm
"RTN","SAMICAS2",629,0)
 set datepart=key
"RTN","SAMICAS2",630,0)
 if $length(key,"-")=4 do  ; allow key to be the whole key ie ceform-2018-10-3
"RTN","SAMICAS2",631,0)
 . set frm=$piece(key,"-",1)
"RTN","SAMICAS2",632,0)
 . set datepart=$piece(key,frm_"-",2)
"RTN","SAMICAS2",633,0)
 set X=datepart
"RTN","SAMICAS2",634,0)
 do ^%DT
"RTN","SAMICAS2",635,0)
 quit Y
"RTN","SAMICAS2",636,0)
 ;
"RTN","SAMICAS2",637,0)
 ;@section 3 casetbl
"RTN","SAMICAS2",638,0)
 ;
"RTN","SAMICAS2",639,0)
 ;@ppi - extrinsic returns the value of 'samistatus' from the form
"RTN","SAMICAS2",640,0)
GSAMISTA(sid,form) ; extrinsic returns the value of 'samistatus' from the form
"RTN","SAMICAS2",641,0)
 ;@called by
"RTN","SAMICAS2",642,0)
 ; WSCASE^SAMICAS2
"RTN","SAMICAS2",643,0)
 ;@calls
"RTN","SAMICAS2",644,0)
 ; $$setroot^%wd
"RTN","SAMICAS2",645,0)
 ;@input
"RTN","SAMICAS2",646,0)
 ; sid  = patient's studyid
"RTN","SAMICAS2",647,0)
 ; form = specific study form (e.g. "sbform-2018-02-26")
"RTN","SAMICAS2",648,0)
 ;@output
"RTN","SAMICAS2",649,0)
 ; status of the form
"RTN","SAMICAS2",650,0)
 ;@tests
"RTN","SAMICAS2",651,0)
 ; SAMIUTS2
"RTN","SAMICAS2",652,0)
 ;
"RTN","SAMICAS2",653,0)
 new stat,root,useform
"RTN","SAMICAS2",654,0)
 set root=$$setroot^%wd("vapals-patients")
"RTN","SAMICAS2",655,0)
 set useform=form
"RTN","SAMICAS2",656,0)
 if form["vapals:" set useform=$p(form,"vapals:",2)
"RTN","SAMICAS2",657,0)
 set stat=$get(@root@("graph",sid,useform,"samistatus"))
"RTN","SAMICAS2",658,0)
 quit stat
"RTN","SAMICAS2",659,0)
 ;
"RTN","SAMICAS2",660,0)
 ;@ppi - sets 'samistatus' to val in form
"RTN","SAMICAS2",661,0)
SSAMISTA ; sets 'samistatus' to val in form
"RTN","SAMICAS2",662,0)
 ;@called by
"RTN","SAMICAS2",663,0)
 ; SSAMISTA^SAMICASE
"RTN","SAMICAS2",664,0)
 ;@calls
"RTN","SAMICAS2",665,0)
 ; $$setroot^%wd
"RTN","SAMICAS2",666,0)
 ;@input
"RTN","SAMICAS2",667,0)
 ; sid   = patient's studyid
"RTN","SAMICAS2",668,0)
 ; form  = specific study form (e.g. "sbform-2018-02-26")
"RTN","SAMICAS2",669,0)
 ; value = status (complete, incomplete)
"RTN","SAMICAS2",670,0)
 ;@output
"RTN","SAMICAS2",671,0)
 ; sets 'samistatus' to val in form
"RTN","SAMICAS2",672,0)
 ;@tests
"RTN","SAMICAS2",673,0)
 ;
"RTN","SAMICAS2",674,0)
 new root,useform
"RTN","SAMICAS2",675,0)
 set root=$$setroot^%wd("vapals-patients")
"RTN","SAMICAS2",676,0)
 set useform=form
"RTN","SAMICAS2",677,0)
 if form["vapals:" set useform=$piece(form,"vapals:",2)
"RTN","SAMICAS2",678,0)
 if '$d(@root@("graph",sid,useform)) quit  ; no form there
"RTN","SAMICAS2",679,0)
 set @root@("graph",sid,useform,"samistatus")=val
"RTN","SAMICAS2",680,0)
 quit
"RTN","SAMICAS2",681,0)
 ;
"RTN","SAMICAS2",682,0)
 ;
"RTN","SAMICAS2",683,0)
 ;@ppi - deletes a form if it is incomplete
"RTN","SAMICAS2",684,0)
DELFORM ; deletes a form if it is incomplete
"RTN","SAMICAS2",685,0)
 ; will not delete intake or background forms
"RTN","SAMICAS2",686,0)
 ;@called by
"RTN","SAMICAS2",687,0)
 ; DELFORM^SAMICASE
"RTN","SAMICAS2",688,0)
 ;@calls
"RTN","SAMICAS2",689,0)
 ; $$setroot^%wd
"RTN","SAMICAS2",690,0)
 ; $$GSAMISTA^SAMICAS2
"RTN","SAMICAS2",691,0)
 ; WSCASE^SAMICAS2
"RTN","SAMICAS2",692,0)
 ;@input
"RTN","SAMICAS2",693,0)
 ; .ARGS=
"RTN","SAMICAS2",694,0)
 ; .ARGS("studyid")
"RTN","SAMICAS2",695,0)
 ; .ARGS("form")
"RTN","SAMICAS2",696,0)
 ;@output
"RTN","SAMICAS2",697,0)
 ; @RESULT
"RTN","SAMICAS2",698,0)
 ;@tests
"RTN","SAMICAS2",699,0)
 ; SAMIUTS2
"RTN","SAMICAS2",700,0)
 ;
"RTN","SAMICAS2",701,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMICAS2",702,0)
 new sid,form
"RTN","SAMICAS2",703,0)
 set sid=$get(ARGS("studyid"))
"RTN","SAMICAS2",704,0)
 quit:sid=""
"RTN","SAMICAS2",705,0)
 set form=$get(ARGS("form"))
"RTN","SAMICAS2",706,0)
 quit:form=""
"RTN","SAMICAS2",707,0)
 if form["siform" quit  ;
"RTN","SAMICAS2",708,0)
 ;if '$data(@root@("graph",sid,form)) quit  ; form does not exist
"RTN","SAMICAS2",709,0)
 if $$GSAMISTA(sid,form)="incomplete" do  ;
"RTN","SAMICAS2",710,0)
 . kill @root@("graph",sid,form)
"RTN","SAMICAS2",711,0)
 kill ARGS("samiroute")
"RTN","SAMICAS2",712,0)
 do WSCASE^SAMICASE(.RESULT,.ARGS)
"RTN","SAMICAS2",713,0)
 quit
"RTN","SAMICAS2",714,0)
 ;
"RTN","SAMICAS2",715,0)
 ;
"RTN","SAMICAS2",716,0)
INITSTAT ; set all forms to 'incomplete'
"RTN","SAMICAS2",717,0)
 ;@called by : none
"RTN","SAMICAS2",718,0)
 ;@calls
"RTN","SAMICAS2",719,0)
 ; SSAMISTA^SAMICASE
"RTN","SAMICAS2",720,0)
 ;@input : none
"RTN","SAMICAS2",721,0)
 ;@output
"RTN","SAMICAS2",722,0)
 ; set all forms to 'incomplete'
"RTN","SAMICAS2",723,0)
 ;@tests
"RTN","SAMICAS2",724,0)
 ;
"RTN","SAMICAS2",725,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMICAS2",726,0)
 new zi,zj set (zi,zj)=""
"RTN","SAMICAS2",727,0)
 for  set zi=$order(@root@("graph",zi)) quit:zi=""  do  ;
"RTN","SAMICAS2",728,0)
 . for  set zj=$order(@root@("graph",zi,zj)) quit:zj=""  do  ;
"RTN","SAMICAS2",729,0)
 . . if zj["siform" do SSAMISTA^SAMICASE(zi,zj,"complete") quit  ;
"RTN","SAMICAS2",730,0)
 . . do SSAMISTA^SAMICASE(zi,zj,"incomplete")
"RTN","SAMICAS2",731,0)
 quit
"RTN","SAMICAS2",732,0)
 ;
"RTN","SAMICAS2",733,0)
 ;
"RTN","SAMICAS2",734,0)
EOR ; end of routine SAMICAS2
"RTN","SAMIFLD")
0^8^B200769481
"RTN","SAMIFLD",1,0)
SAMIFLD ;ven/gpl - elcap: form load & case review support ;Oct 22, 2019@15:36
"RTN","SAMIFLD",2,0)
 ;;18.0;SAMI;;;Build 12
"RTN","SAMIFLD",3,0)
 ;
"RTN","SAMIFLD",4,0)
 ; Routine SAMIFLD contains subroutines for processing the ELCAP forms,
"RTN","SAMIFLD",5,0)
 ; specifically loading JSON data into the graphstore for each line.
"RTN","SAMIFLD",6,0)
 ; Since three of those subroutines are also code for ppis called by
"RTN","SAMIFLD",7,0)
 ; WSCASE^SAMICASE, two additional subroutines are included that are not
"RTN","SAMIFLD",8,0)
 ; part of the LOAD opus but are called by WSCASE^SAMICASE.
"RTN","SAMIFLD",9,0)
 ; SAMIFLD contains no public entry points (see SAMIFORM).
"RTN","SAMIFLD",10,0)
 ;
"RTN","SAMIFLD",11,0)
 quit  ; no entry from top
"RTN","SAMIFLD",12,0)
 ;
"RTN","SAMIFLD",13,0)
 ;
"RTN","SAMIFLD",14,0)
 ;
"RTN","SAMIFLD",15,0)
 ;@section 0 primary development
"RTN","SAMIFLD",16,0)
 ;
"RTN","SAMIFLD",17,0)
 ;
"RTN","SAMIFLD",18,0)
 ;
"RTN","SAMIFLD",19,0)
 ;@routine-credits
"RTN","SAMIFLD",20,0)
 ;@primary-dev: George P. Lilly (gpl)
"RTN","SAMIFLD",21,0)
 ; gpl@vistaexpertise.net
"RTN","SAMIFLD",22,0)
 ;@primary-dev-org: Vista Expertise Network (ven)
"RTN","SAMIFLD",23,0)
 ; http://vistaexpertise.net
"RTN","SAMIFLD",24,0)
 ;@copyright: 2017/2019, gpl, all rights reserved
"RTN","SAMIFLD",25,0)
 ;@license: Apache 2.0
"RTN","SAMIFLD",26,0)
 ; https://www.apache.org/licenses/LICENSE-2.0.html
"RTN","SAMIFLD",27,0)
 ;
"RTN","SAMIFLD",28,0)
 ;@last-updated: 2019-08-01T15:42Z
"RTN","SAMIFLD",29,0)
 ;@application: Screening Applications Management (SAM)
"RTN","SAMIFLD",30,0)
 ;@module: Screening Applications Management - VAPALS-ELCAP (SAMI)
"RTN","SAMIFLD",31,0)
 ;@version: 18.0T04 (fourth development version)
"RTN","SAMIFLD",32,0)
 ;@release-date: not yet released
"RTN","SAMIFLD",33,0)
 ;@patch-list: none yet
"RTN","SAMIFLD",34,0)
 ;
"RTN","SAMIFLD",35,0)
 ;@additional-dev: Frederick D. S. Marshall (toad)
"RTN","SAMIFLD",36,0)
 ; toad@vistaexpertise.net
"RTN","SAMIFLD",37,0)
 ;@additional-dev: Larry G. Carlson (lgc)
"RTN","SAMIFLD",38,0)
 ; lgc@vistaexpertise.net
"RTN","SAMIFLD",39,0)
 ;@additional-dev: Alexis Carlson (arc)
"RTN","SAMIFLD",40,0)
 ; alexis.carlson@vistaexpertise.net
"RTN","SAMIFLD",41,0)
 ;
"RTN","SAMIFLD",42,0)
 ;@module-credits [see SAMIFUL]
"RTN","SAMIFLD",43,0)
 ;
"RTN","SAMIFLD",44,0)
 ;@contents
"RTN","SAMIFLD",45,0)
 ; LOAD: code for ppi LOAD^SAMIFORM
"RTN","SAMIFLD",46,0)
 ;  used for Dom's new style forms
"RTN","SAMIFLD",47,0)
 ;
"RTN","SAMIFLD",48,0)
 ; $$GETHDR = header string for patient sid
"RTN","SAMIFLD",49,0)
 ;
"RTN","SAMIFLD",50,0)
 ; GETLAST5 = code for ppi $$GETLAST5^SAMIFORM
"RTN","SAMIFLD",51,0)
 ;  last5 for patient sid
"RTN","SAMIFLD",52,0)
 ; FIXSRC: code for ppi FIXSRC^SAMIFORM
"RTN","SAMIFLD",53,0)
 ;  fix html src lines to use resources in see/
"RTN","SAMIFLD",54,0)
 ; FIXHREF: code for ppi FIXHREF^SAMIFORM
"RTN","SAMIFLD",55,0)
 ;  fix html href lines to use resources in see/
"RTN","SAMIFLD",56,0)
 ;
"RTN","SAMIFLD",57,0)
 ; GETNAME = code for ppi $$GETNAME^SAMIFORM
"RTN","SAMIFLD",58,0)
 ;  name for patient sid
"RTN","SAMIFLD",59,0)
 ; GETSSN = code for ppi $$GETSSN^SAMIFORM
"RTN","SAMIFLD",60,0)
 ;  ssn for patient sid
"RTN","SAMIFLD",61,0)
 ;
"RTN","SAMIFLD",62,0)
 ;
"RTN","SAMIFLD",63,0)
 ;
"RTN","SAMIFLD",64,0)
 ;@section 1 code for ppi LOAD^SAMIFRM
"RTN","SAMIFLD",65,0)
 ;
"RTN","SAMIFLD",66,0)
 ;
"RTN","SAMIFLD",67,0)
 ;
"RTN","SAMIFLD",68,0)
 ;@ppi-code LOAD^SAMIFORM
"RTN","SAMIFLD",69,0)
LOAD ; process html line, e.g., load json data into graph
"RTN","SAMIFLD",70,0)
 ;
"RTN","SAMIFLD",71,0)
 ;@signature
"RTN","SAMIFLD",72,0)
 ; do LOAD^SAMIFORM(.SAMILINE,form,sid,.SAMIFILTER,.SAMILNUM,.SAMIHTML,.SAMIVALS)
"RTN","SAMIFLD",73,0)
 ;@branches-from
"RTN","SAMIFLD",74,0)
 ; LOAD^SAMIFORM
"RTN","SAMIFLD",75,0)
 ;@ppi-called-by
"RTN","SAMIFLD",76,0)
 ; wsGetForm^%wf
"RTN","SAMIFLD",77,0)
 ; WSNOTE^SAMINOTI
"RTN","SAMIFLD",78,0)
 ; WSREPORT^SAMIUR1
"RTN","SAMIFLD",79,0)
 ;@called-by: none
"RTN","SAMIFLD",80,0)
 ;@calls
"RTN","SAMIFLD",81,0)
 ; $$GETHDR
"RTN","SAMIFLD",82,0)
 ; $$GETLAST5^SAMIFORM
"RTN","SAMIFLD",83,0)
 ; findReplace^%ts
"RTN","SAMIFLD",84,0)
 ; findReplaceAll^%ts
"RTN","SAMIFLD",85,0)
 ; FIXSRC^SAMIFORM
"RTN","SAMIFLD",86,0)
 ; FIXHREF^SAMIFORM
"RTN","SAMIFLD",87,0)
 ;@thruput
"RTN","SAMIFLD",88,0)
 ;.SAMILINE = line of html
"RTN","SAMIFLD",89,0)
 ; SAMILINE("low") = lowercase line for easier checks
"RTN","SAMIFLD",90,0)
 ;.SAMIFILTER = work-parameters array
"RTN","SAMIFLD",91,0)
 ; SAMIFILTER("debug") = 1 to debug some fields, 2 to debug more fields
"RTN","SAMIFLD",92,0)
 ; SAMIFILTER("errormessagestyle") = 2 (default) = use current error msg style
"RTN","SAMIFLD",93,0)
 ; SAMIFILTER("form") = form id (e.g., "vapals:sbform")
"RTN","SAMIFLD",94,0)
 ; SAMIFILTER("key") = graph key for saved form (e.g., "ceform-2019-07-01")
"RTN","SAMIFLD",95,0)
 ; SAMIFILTER("studyid") = patient study id (e.g., "XXX00045")
"RTN","SAMIFLD",96,0)
 ; SAMIFILTER("fvalue") = deprecated
"RTN","SAMIFLD",97,0)
 ;.SAMILNUM = html line #, in case need to reset cursor to skip lines
"RTN","SAMIFLD",98,0)
 ;.SAMIHTML = complete html form, in case other lines need changing
"RTN","SAMIFLD",99,0)
 ;@input
"RTN","SAMIFLD",100,0)
 ; form = form id
"RTN","SAMIFLD",101,0)
 ; sid = patient study id
"RTN","SAMIFLD",102,0)
 ;.SAMIVALS = field values
"RTN","SAMIFLD",103,0)
 ; SAMIVALS("saminame")
"RTN","SAMIFLD",104,0)
 ; SAMIVALS("samistatus")
"RTN","SAMIFLD",105,0)
 ; SAMIVALS("samifirsttime")
"RTN","SAMIFLD",106,0)
 ;@tests
"RTN","SAMIFLD",107,0)
 ; UTSSUB2^SAMIUTF2: used for Dom's new style forms
"RTN","SAMIFLD",108,0)
 ;
"RTN","SAMIFLD",109,0)
 ; This line processor/data loader can modify any line in the html as needed.
"RTN","SAMIFLD",110,0)
 ;
"RTN","SAMIFLD",111,0)
 new touched set touched=0
"RTN","SAMIFLD",112,0)
 ;
"RTN","SAMIFLD",113,0)
 set SAMILINE=SAMILINE_$char(13,10) ; insert CRLF at end of every line
"RTN","SAMIFLD",114,0)
 ; for readability in browser
"RTN","SAMIFLD",115,0)
 ;
"RTN","SAMIFLD",116,0)
 new pssn set pssn=$$GETHDR(sid)
"RTN","SAMIFLD",117,0)
 i pssn=""  d  ; for participants without a sid - ie not registered
"RTN","SAMIFLD",118,0)
 . n dfn,lien
"RTN","SAMIFLD",119,0)
 . s dfn=$g(SAMIFILTER("dfn")) ; if no sid, maybe a dfn
"RTN","SAMIFLD",120,0)
 . q:dfn=""
"RTN","SAMIFLD",121,0)
 . n lroot s lroot=$$setroot^%wd("patient-lookup") ; 
"RTN","SAMIFLD",122,0)
 . s lien=$o(@lroot@("dfn",dfn,""))
"RTN","SAMIFLD",123,0)
 . q:lien=""
"RTN","SAMIFLD",124,0)
 . n ssn s ssn=$g(@lroot@(lien,"ssn"))
"RTN","SAMIFLD",125,0)
 . q:ssn=""
"RTN","SAMIFLD",126,0)
 . s pssn=$e(ssn,1,3)_"-"_$e(ssn,4,5)_"-"_$e(ssn,6,9)
"RTN","SAMIFLD",127,0)
 new last5 set last5=$$GETLAST5^SAMIFORM(sid)
"RTN","SAMIFLD",128,0)
 new useid set useid=pssn
"RTN","SAMIFLD",129,0)
 if useid="" set useid=last5
"RTN","SAMIFLD",130,0)
 ;
"RTN","SAMIFLD",131,0)
 if SAMILINE["@@FORMKEY@@" do  ; insert form id (graph key for new forms)
"RTN","SAMIFLD",132,0)
 . do findReplace^%ts(.SAMILINE,"@@FORMKEY@@",form) ; key -> form, test me
"RTN","SAMIFLD",133,0)
 . quit
"RTN","SAMIFLD",134,0)
 ;
"RTN","SAMIFLD",135,0)
 if SAMILINE["@@SID@@" do  ; insert patient study id
"RTN","SAMIFLD",136,0)
 . do findReplace^%ts(.SAMILINE,"@@SID@@",sid)
"RTN","SAMIFLD",137,0)
 . quit
"RTN","SAMIFLD",138,0)
 ;
"RTN","SAMIFLD",139,0)
 if SAMILINE["@@SITE@@" do  ; insert site id
"RTN","SAMIFLD",140,0)
 . n siteid s siteid=$g(SAMIVALS("siteid"))
"RTN","SAMIFLD",141,0)
 . i siteid="" s siteid=$g(SAMIFILTER("siteid"))
"RTN","SAMIFLD",142,0)
 . q:siteid=""
"RTN","SAMIFLD",143,0)
 . do findReplace^%ts(.SAMILINE,"@@SITE@@",siteid)
"RTN","SAMIFLD",144,0)
 . quit
"RTN","SAMIFLD",145,0)
 ;
"RTN","SAMIFLD",146,0)
 if SAMILINE["@@SITETITLE@@" do  ; insert site title
"RTN","SAMIFLD",147,0)
 . n sitetit s sitetit=$g(SAMIVALS("sitetitle"))
"RTN","SAMIFLD",148,0)
 . i sitetit="" s sitetit=$g(SAMIFILTER("sitetitle"))
"RTN","SAMIFLD",149,0)
 . q:sitetit=""
"RTN","SAMIFLD",150,0)
 . do findReplace^%ts(.SAMILINE,"@@SITETITLE@@",sitetit)
"RTN","SAMIFLD",151,0)
 . quit
"RTN","SAMIFLD",152,0)
 ;
"RTN","SAMIFLD",153,0)
 if SAMILINE["@@MANUALREGISTRATION@@" do  ; turn off manual registration
"RTN","SAMIFLD",154,0)
 . n setman,setparm
"RTN","SAMIFLD",155,0)
 . s setman="true"
"RTN","SAMIFLD",156,0)
 . s setparm=$$GET^XPAR("SYS","SAMI ALLOW MANUAL ENTRY",,"Q")
"RTN","SAMIFLD",157,0)
 . i setparm=0 s setman="false"
"RTN","SAMIFLD",158,0)
 . do findReplace^%ts(.SAMILINE,"@@MANUALREGISTRATION@@",setman)
"RTN","SAMIFLD",159,0)
 ; 
"RTN","SAMIFLD",160,0)
 if SAMILINE["@@DFN@@" do  ; insert patient study id
"RTN","SAMIFLD",161,0)
 . n dfn s dfn=$g(SAMIVALS("dfn"))
"RTN","SAMIFLD",162,0)
 . q:dfn=""
"RTN","SAMIFLD",163,0)
 . do findReplace^%ts(.SAMILINE,"@@DFN@@",dfn)
"RTN","SAMIFLD",164,0)
 . quit
"RTN","SAMIFLD",165,0)
 ;
"RTN","SAMIFLD",166,0)
 if SAMILINE["src=" do  ; repoint src directory references
"RTN","SAMIFLD",167,0)
 . do FIXSRC^SAMIFORM(.SAMILINE) ; insert see/ processor on src= references
"RTN","SAMIFLD",168,0)
 . quit
"RTN","SAMIFLD",169,0)
 ;
"RTN","SAMIFLD",170,0)
 if SAMILINE["href=" if 'touched do  ; repoint href directory references
"RTN","SAMIFLD",171,0)
 . do FIXHREF^SAMIFORM(.SAMILINE) ; insert see/ processor on href= references
"RTN","SAMIFLD",172,0)
 . quit
"RTN","SAMIFLD",173,0)
 ;
"RTN","SAMIFLD",174,0)
 if SAMILINE["Sample, Sammy G" do  ; insert actual patient name
"RTN","SAMIFLD",175,0)
 . ;do findReplace^%ts(.SAMILINE,"Sample, Sammy G",$get(SAMIVALS("saminame")))
"RTN","SAMIFLD",176,0)
 . do findReplace^%ts(.SAMILINE,"Sample, Sammy G",$$GETNAME^SAMIFORM(sid))
"RTN","SAMIFLD",177,0)
 . quit
"RTN","SAMIFLD",178,0)
 ;
"RTN","SAMIFLD",179,0)
 if SAMILINE["ST0001" do  ; insert patient ssn or last 5
"RTN","SAMIFLD",180,0)
 . do findReplace^%ts(.SAMILINE,"ST0001",useid)
"RTN","SAMIFLD",181,0)
 . quit
"RTN","SAMIFLD",182,0)
 ;
"RTN","SAMIFLD",183,0)
 if SAMILINE["1234567890" do  ; cut patient id placeholder
"RTN","SAMIFLD",184,0)
 . do findReplace^%ts(.SAMILINE,"1234567890","")
"RTN","SAMIFLD",185,0)
 . quit
"RTN","SAMIFLD",186,0)
 ;
"RTN","SAMIFLD",187,0)
 if SAMILINE["XX0002" do  ; insert patient study id
"RTN","SAMIFLD",188,0)
 . if SAMILINE["XXX" quit  ;
"RTN","SAMIFLD",189,0)
 . do findReplace^%ts(.SAMILINE,"XX0002",sid)
"RTN","SAMIFLD",190,0)
 . quit
"RTN","SAMIFLD",191,0)
 ;
"RTN","SAMIFLD",192,0)
 if SAMILINE["VEP0001" do  ; insert patient study id
"RTN","SAMIFLD",193,0)
 . do findReplaceAll^%ts(.SAMILINE,"VEP0001",sid)
"RTN","SAMIFLD",194,0)
 . quit
"RTN","SAMIFLD",195,0)
 ;
"RTN","SAMIFLD",196,0)
 if SAMILINE["@@FROZEN@@" do  ; insert whether form is frozen
"RTN","SAMIFLD",197,0)
 . if $get(SAMIVALS("samistatus"))="complete" do  ;
"RTN","SAMIFLD",198,0)
 . . do findReplace^%ts(.SAMILINE,"@@FROZEN@@","true")
"RTN","SAMIFLD",199,0)
 . . quit
"RTN","SAMIFLD",200,0)
 . else  do  ;
"RTN","SAMIFLD",201,0)
 . . do findReplace^%ts(.SAMILINE,"@@FROZEN@@","false")
"RTN","SAMIFLD",202,0)
 . . quit
"RTN","SAMIFLD",203,0)
 . quit
"RTN","SAMIFLD",204,0)
 ;
"RTN","SAMIFLD",205,0)
 if SAMILINE["@@NEWFORM@@" do  ; insert whether first edit of form
"RTN","SAMIFLD",206,0)
 . if $get(SAMIVALS("samifirsttime"))="true" do  ;
"RTN","SAMIFLD",207,0)
 . . do findReplace^%ts(.SAMILINE,"@@NEWFORM@@","true")
"RTN","SAMIFLD",208,0)
 . . quit
"RTN","SAMIFLD",209,0)
 . else  do  ;
"RTN","SAMIFLD",210,0)
 . . do findReplace^%ts(.SAMILINE,"@@NEWFORM@@","false")
"RTN","SAMIFLD",211,0)
 . . quit
"RTN","SAMIFLD",212,0)
 . quit
"RTN","SAMIFLD",213,0)
 ;
"RTN","SAMIFLD",214,0)
 if SAMILINE["@@CHART_ELIGIBILITY_NOTE_EXISTS@@" d  ;
"RTN","SAMIFLD",215,0)
 . n zexist
"RTN","SAMIFLD",216,0)
 . s zexist=$$EXISTCE^SAMINOT1(sid,form)
"RTN","SAMIFLD",217,0)
 . do findReplace^%ts(.SAMILINE,"@@CHART_ELIGIBILITY_NOTE_EXISTS@@",zexist)
"RTN","SAMIFLD",218,0)
 ;
"RTN","SAMIFLD",219,0)
 if SAMILINE["@@PRE_ENROLLMENT_NOTE_EXISTS@@" d  ;
"RTN","SAMIFLD",220,0)
 . n zexist
"RTN","SAMIFLD",221,0)
 . s zexist=$$EXISTPRE^SAMINOT1(sid,form)
"RTN","SAMIFLD",222,0)
 . do findReplace^%ts(.SAMILINE,"@@PRE_ENROLLMENT_NOTE_EXISTS@@",zexist)
"RTN","SAMIFLD",223,0)
 ;
"RTN","SAMIFLD",224,0)
 if SAMILINE["@@INTAKE_NOTE_EXISTS@@" d  ;
"RTN","SAMIFLD",225,0)
 . n zexist
"RTN","SAMIFLD",226,0)
 . s zexist=$$EXISTINT^SAMINOT1(sid,form)
"RTN","SAMIFLD",227,0)
 . do findReplace^%ts(.SAMILINE,"@@INTAKE_NOTE_EXISTS@@",zexist)
"RTN","SAMIFLD",228,0)
 ;
"RTN","SAMIFLD",229,0)
 if SAMILINE["changelog" d  ;
"RTN","SAMIFLD",230,0)
 . new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMIFLD",231,0)
 . new clog set clog=$na(@root@("graph",sid,form,"changelog"))
"RTN","SAMIFLD",232,0)
 . if '$d(@clog) q  ;
"RTN","SAMIFLD",233,0)
 . do findReplace^%ts(.SAMILINE,"</pre>","")
"RTN","SAMIFLD",234,0)
 . new zi set zi=""
"RTN","SAMIFLD",235,0)
 . for  set zi=$order(@clog@(zi)) quit:zi=""  d  ;
"RTN","SAMIFLD",236,0)
 . . new zien set zien=SAMILNUM_"."_$$xpand(zi)
"RTN","SAMIFLD",237,0)
 . . set zhtml(zien)=@clog@(zi)
"RTN","SAMIFLD",238,0)
 . set zhtml(SAMILNUM_"."_$$xpand($order(@clog@(""),-1)+1))="</pre>"
"RTN","SAMIFLD",239,0)
 ;
"RTN","SAMIFLD",240,0)
 if SAMILINE["commlog" d  ;
"RTN","SAMIFLD",241,0)
 . new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMIFLD",242,0)
 . new clog set clog=$na(@root@("graph",sid,form,"comlog"))
"RTN","SAMIFLD",243,0)
 . if '$d(@clog) q  ;
"RTN","SAMIFLD",244,0)
 . do findReplace^%ts(.SAMILINE,"</pre>","")
"RTN","SAMIFLD",245,0)
 . new zi set zi=""
"RTN","SAMIFLD",246,0)
 . for  set zi=$order(@clog@(zi)) quit:zi=""  d  ;
"RTN","SAMIFLD",247,0)
 . . new zien set zien=SAMILNUM_"."_$$xpand(zi)
"RTN","SAMIFLD",248,0)
 . . set zhtml(zien)=@clog@(zi)
"RTN","SAMIFLD",249,0)
 . set zhtml(SAMILNUM_"."_$$xpand($order(@clog@(""),-1)+1))="</pre>"
"RTN","SAMIFLD",250,0)
 ;
"RTN","SAMIFLD",251,0)
 ;if form["fuform" d  ;
"RTN","SAMIFLD",252,0)
 i SAMILINE["pack-years-history" d  ;
"RTN","SAMIFLD",253,0)
 . d  ;
"RTN","SAMIFLD",254,0)
 . . i SAMILINE'["id" q  ;
"RTN","SAMIFLD",255,0)
 . . n zzi s zzi=SAMILNUM
"RTN","SAMIFLD",256,0)
 . . f  s zzi=$o(SAMIHTML(zzi)) q:zzi>(SAMILNUM+20)  q:SAMIHTML(zzi)["tbody"  d
"RTN","SAMIFLD",257,0)
 . . . s SAMIHTML(zzi)=SAMIHTML(zzi)_$char(13,10)
"RTN","SAMIFLD",258,0)
 . . ;s SAMIHTML(zzi)="<tbody>"_$$SHDET^SAMIUR2(sid)
"RTN","SAMIFLD",259,0)
 . . s SAMILNUM=zzi+1
"RTN","SAMIFLD",260,0)
 . . s SAMILINE=$$SHDET^SAMIUR2(sid,form)_"</tbody>"
"RTN","SAMIFLD",261,0)
 ;
"RTN","SAMIFLD",262,0)
 i SAMILINE["@@ERROR_MESSAGE@@" d  ;
"RTN","SAMIFLD",263,0)
 . n errMsg s errMsg=$get(SAMIVALS("errorMessage"))
"RTN","SAMIFLD",264,0)
 . if errMsg="" q  ; no error message
"RTN","SAMIFLD",265,0)
 . do findReplace^%ts(.SAMILINE,"@@ERROR_MESSAGE@@",errMsg)
"RTN","SAMIFLD",266,0)
 ;
"RTN","SAMIFLD",267,0)
 i SAMILINE["@@ERROR_FIELDS@@" d  ;
"RTN","SAMIFLD",268,0)
 . n errFld s errFld=$get(SAMIVALS("errorField"))
"RTN","SAMIFLD",269,0)
 . if errFld="" q  ; no error field
"RTN","SAMIFLD",270,0)
 . do findReplace^%ts(.SAMILINE,"@@ERROR_FIELDS@@",errFld)
"RTN","SAMIFLD",271,0)
 ;
"RTN","SAMIFLD",272,0)
 i SAMILINE["@@INFO_MESSAGE@@" d  ;
"RTN","SAMIFLD",273,0)
 . n infoMsg s infoMsg=$get(SAMIVALS("infoMessage"))
"RTN","SAMIFLD",274,0)
 . if infoMsg="" q  ; no message
"RTN","SAMIFLD",275,0)
 . do findReplace^%ts(.SAMILINE,"@@INFO_MESSAGE@@",infoMsg)
"RTN","SAMIFLD",276,0)
 ;
"RTN","SAMIFLD",277,0)
 i SAMILINE["@@WARN_MESSAGE@@" d  ;
"RTN","SAMIFLD",278,0)
 . n warnMsg s warnMsg=$get(SAMIVALS("warnMessage"))
"RTN","SAMIFLD",279,0)
 . if warnMsg="" q  ; no message
"RTN","SAMIFLD",280,0)
 . do findReplace^%ts(.SAMILINE,"@@WARN_MESSAGE@@",warnMsg)
"RTN","SAMIFLD",281,0)
 ;
"RTN","SAMIFLD",282,0)
 quit  ; end of ppi LOAD^SAMIFORM
"RTN","SAMIFLD",283,0)
 ;
"RTN","SAMIFLD",284,0)
xpand(zi) ; extrinsic that expands a number to 8 digits with preceeding 0
"RTN","SAMIFLD",285,0)
 ; and add a 1 at the end so that 10,20 etc still collate
"RTN","SAMIFLD",286,0)
 n g1,g2,g3
"RTN","SAMIFLD",287,0)
 s g1=8-$l(zi)
"RTN","SAMIFLD",288,0)
 s $p(g2,"0",g1)=""
"RTN","SAMIFLD",289,0)
 s g3=g2_zi_"1"
"RTN","SAMIFLD",290,0)
 q g3
"RTN","SAMIFLD",291,0)
 ;
"RTN","SAMIFLD",292,0)
 ;
"RTN","SAMIFLD",293,0)
GETHDR(sid) ; header string for patient sid
"RTN","SAMIFLD",294,0)
 ;
"RTN","SAMIFLD",295,0)
 ;@signature
"RTN","SAMIFLD",296,0)
 ; $$GETHDR^SAMIFORM(sid)
"RTN","SAMIFLD",297,0)
 ;@called-by
"RTN","SAMIFLD",298,0)
 ; LOAD
"RTN","SAMIFLD",299,0)
 ;@calls
"RTN","SAMIFLD",300,0)
 ; $$setroot^%wd
"RTN","SAMIFLD",301,0)
 ; PREFILL^SAMIHOM3
"RTN","SAMIFLD",302,0)
 ; ^%DT
"RTN","SAMIFLD",303,0)
 ; $$NOW^XLFDT
"RTN","SAMIFLD",304,0)
 ; $$FMDIFF^XLFDT
"RTN","SAMIFLD",305,0)
 ;@input
"RTN","SAMIFLD",306,0)
 ; sid = patient study id
"RTN","SAMIFLD",307,0)
 ;@output = header string (patient id dob age gender)
"RTN","SAMIFLD",308,0)
 ;@tests
"RTN","SAMIFLD",309,0)
 ; UTGETHDR^SAMIUTF2: header string for patient sid
"RTN","SAMIFLD",310,0)
 ;
"RTN","SAMIFLD",311,0)
 quit:$get(sid)="" ""
"RTN","SAMIFLD",312,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMIFLD",313,0)
 new ien set ien=$order(@root@("sid",sid,""))
"RTN","SAMIFLD",314,0)
 new dfn set dfn=@root@(ien,"dfn")
"RTN","SAMIFLD",315,0)
 quit:ien=""
"RTN","SAMIFLD",316,0)
 ;
"RTN","SAMIFLD",317,0)
 ; do PREFILL^SAMIHOM3(dfn) ; update from Vista
"RTN","SAMIFLD",318,0)
 if $get(@root@(ien,"ssn"))="" do PREFILL^SAMIHOM3(dfn) ; update from Vista
"RTN","SAMIFLD",319,0)
 if $get(@root@(ien,"sbdob"))=-1 do PREFILL^SAMIHOM3(dfn) ; update from Vista
"RTN","SAMIFLD",320,0)
 ;
"RTN","SAMIFLD",321,0)
 if $get(@root@(ien,"ssn"))="" quit "" ; patient info not available
"RTN","SAMIFLD",322,0)
 new pssn set pssn=$get(@root@(ien,"sissn"))
"RTN","SAMIFLD",323,0)
 if pssn["sta" set pssn=""
"RTN","SAMIFLD",324,0)
 if pssn="" do  ;
"RTN","SAMIFLD",325,0)
 . new orgssn
"RTN","SAMIFLD",326,0)
 . set orgssn=$get(@root@(ien,"ssn"))
"RTN","SAMIFLD",327,0)
 . quit:orgssn=""
"RTN","SAMIFLD",328,0)
 . set pssn=$extract(orgssn,1,3)_"-"_$extract(orgssn,4,5)_"-"_$extract(orgssn,6,9)
"RTN","SAMIFLD",329,0)
 . set @root@(ien,"sissn")=pssn
"RTN","SAMIFLD",330,0)
 . quit
"RTN","SAMIFLD",331,0)
 ;
"RTN","SAMIFLD",332,0)
AGE new dob set dob=$get(@root@(ien,"sbdob")) ; dob in VAPALS format
"RTN","SAMIFLD",333,0)
 new X set X=dob
"RTN","SAMIFLD",334,0)
 new Y
"RTN","SAMIFLD",335,0)
 do ^%DT
"RTN","SAMIFLD",336,0)
 ;
"RTN","SAMIFLD",337,0)
 ; change ven/lgc 20190628 - calculate age with MASH 
"RTN","SAMIFLD",338,0)
 ;
"RTN","SAMIFLD",339,0)
 ;new age set age=$piece($$FMDIFF^XLFDT($$NOW^XLFDT,Y)/365,".")
"RTN","SAMIFLD",340,0)
 new age s age=$$age^%th(Y)
"RTN","SAMIFLD",341,0)
 ;
"RTN","SAMIFLD",342,0)
 set @root@(ien,"age")=age
"RTN","SAMIFLD",343,0)
 ;
"RTN","SAMIFLD",344,0)
 new sex set sex=$get(@root@(ien,"sex"))
"RTN","SAMIFLD",345,0)
 ;
"RTN","SAMIFLD",346,0)
 new rtn set rtn=pssn_" DOB: "_dob_" AGE: "_age_" GENDER: "_sex
"RTN","SAMIFLD",347,0)
 ;
"RTN","SAMIFLD",348,0)
 quit rtn ; end of $$GETHDR
"RTN","SAMIFLD",349,0)
 ;
"RTN","SAMIFLD",350,0)
 ;
"RTN","SAMIFLD",351,0)
 ;
"RTN","SAMIFLD",352,0)
 ;@section 2 code for ppis $$GETLAST5^SAMIFORM,FIXSRC^SAMIFORM,FIXHREF^SAMIFORM
"RTN","SAMIFLD",353,0)
 ;
"RTN","SAMIFLD",354,0)
 ;
"RTN","SAMIFLD",355,0)
 ;
"RTN","SAMIFLD",356,0)
 ;@ppi-code $$GETLAST5^SAMIFORM
"RTN","SAMIFLD",357,0)
GETLAST5 ; last5 for patient sid
"RTN","SAMIFLD",358,0)
 ;
"RTN","SAMIFLD",359,0)
 ;@signature
"RTN","SAMIFLD",360,0)
 ; $$GETHDR^SAMIFORM(sid)
"RTN","SAMIFLD",361,0)
 ;@branches-from
"RTN","SAMIFLD",362,0)
 ; GETLAST5^SAMIFORM
"RTN","SAMIFLD",363,0)
 ;@ppi-called-by
"RTN","SAMIFLD",364,0)
 ; WSCASE^SAMICAS2
"RTN","SAMIFLD",365,0)
 ; LOAD
"RTN","SAMIFLD",366,0)
 ;@called-by: none
"RTN","SAMIFLD",367,0)
 ;@calls
"RTN","SAMIFLD",368,0)
 ; $$setroot^%wd
"RTN","SAMIFLD",369,0)
 ;@input
"RTN","SAMIFLD",370,0)
 ; sid = patient study id
"RTN","SAMIFLD",371,0)
 ;@output = patient's BS5 (first initial of last name, last 4 of ssn)
"RTN","SAMIFLD",372,0)
 ;@tests
"RTN","SAMIFLD",373,0)
 ; UTGLST5^SAMIUTF2: last5 for patient sid
"RTN","SAMIFLD",374,0)
 ;
"RTN","SAMIFLD",375,0)
 quit:$get(sid)="" ""
"RTN","SAMIFLD",376,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMIFLD",377,0)
 new ien set ien=$order(@root@("sid",sid,""))
"RTN","SAMIFLD",378,0)
 quit:ien=""
"RTN","SAMIFLD",379,0)
 ;
"RTN","SAMIFLD",380,0)
 quit @root@(ien,"last5") ; end of ppi $$GETLAST5^SAMIFORM
"RTN","SAMIFLD",381,0)
 ;
"RTN","SAMIFLD",382,0)
 ;
"RTN","SAMIFLD",383,0)
 ;
"RTN","SAMIFLD",384,0)
 ;@ppi-code FIXSRC^SAMIFORM
"RTN","SAMIFLD",385,0)
FIXSRC ; fix html src lines to use resources in see/
"RTN","SAMIFLD",386,0)
 ;
"RTN","SAMIFLD",387,0)
 ;@signature
"RTN","SAMIFLD",388,0)
 ; do FIXSRC^SAMIFORM(.SAMILINE)
"RTN","SAMIFLD",389,0)
 ;@branches-from
"RTN","SAMIFLD",390,0)
 ; FIXSRC^SAMIFORM
"RTN","SAMIFLD",391,0)
 ;@ppi-called-by
"RTN","SAMIFLD",392,0)
 ; WSCASE^SAMICAS2
"RTN","SAMIFLD",393,0)
 ; LOAD
"RTN","SAMIFLD",394,0)
 ;@called-by: none
"RTN","SAMIFLD",395,0)
 ;@calls
"RTN","SAMIFLD",396,0)
 ; findReplaceAll^%ts
"RTN","SAMIFLD",397,0)
 ;@thruput
"RTN","SAMIFLD",398,0)
 ;.SAMILINE = line of html to change
"RTN","SAMIFLD",399,0)
 ;@tests
"RTN","SAMIFLD",400,0)
 ; UTFSRC^SAMIUTF2: fix html src lines to use resources in see/
"RTN","SAMIFLD",401,0)
 ;
"RTN","SAMIFLD",402,0)
 if SAMILINE["src=" do  ;
"RTN","SAMIFLD",403,0)
 . if SAMILINE["src=""http" quit
"RTN","SAMIFLD",404,0)
 . if SAMILINE["src=""/" do  quit
"RTN","SAMIFLD",405,0)
 . . do findReplaceAll^%ts(.SAMILINE,"src=""/","src=""/see/sami/")
"RTN","SAMIFLD",406,0)
 . . quit
"RTN","SAMIFLD",407,0)
 . if SAMILINE["src=""" do  quit
"RTN","SAMIFLD",408,0)
 . . do findReplaceAll^%ts(.SAMILINE,"src=""","src=""/see/sami/")
"RTN","SAMIFLD",409,0)
 . . quit
"RTN","SAMIFLD",410,0)
 . if SAMILINE["src=" do
"RTN","SAMIFLD",411,0)
 . . do findReplaceAll^%ts(.SAMILINE,"src=","src=/see/sami/")
"RTN","SAMIFLD",412,0)
 . . quit
"RTN","SAMIFLD",413,0)
 . quit
"RTN","SAMIFLD",414,0)
 ;
"RTN","SAMIFLD",415,0)
 quit  ; end of ppi FIXSRC^SAMIFORM
"RTN","SAMIFLD",416,0)
 ;
"RTN","SAMIFLD",417,0)
 ;
"RTN","SAMIFLD",418,0)
 ;
"RTN","SAMIFLD",419,0)
 ;@ppi-code FIXHREF^SAMIFORM
"RTN","SAMIFLD",420,0)
FIXHREF ; fix html href lines to use resources in see/
"RTN","SAMIFLD",421,0)
 ;
"RTN","SAMIFLD",422,0)
 ;@signature
"RTN","SAMIFLD",423,0)
 ; do FIXHREF^SAMIFORM(.SAMILINE)
"RTN","SAMIFLD",424,0)
 ;@branches-from
"RTN","SAMIFLD",425,0)
 ; FIXHREF^SAMIFORM
"RTN","SAMIFLD",426,0)
 ;@ppi-called-by
"RTN","SAMIFLD",427,0)
 ; WSCASE^SAMICAS2
"RTN","SAMIFLD",428,0)
 ; LOAD
"RTN","SAMIFLD",429,0)
 ;@called-by: none
"RTN","SAMIFLD",430,0)
 ;@calls
"RTN","SAMIFLD",431,0)
 ; findReplaceAll^%ts
"RTN","SAMIFLD",432,0)
 ;@thruput
"RTN","SAMIFLD",433,0)
 ;.SAMILINE = line of html to change
"RTN","SAMIFLD",434,0)
 ;@tests
"RTN","SAMIFLD",435,0)
 ; UTFHREF^SAMIUTF2: fix html href lines to use resources in see/
"RTN","SAMIFLD",436,0)
 ;
"RTN","SAMIFLD",437,0)
 if SAMILINE["href=" do  ;
"RTN","SAMIFLD",438,0)
 . quit:SAMILINE["href=""#"
"RTN","SAMIFLD",439,0)
 . quit:SAMILINE["href='#"
"RTN","SAMIFLD",440,0)
 . quit:SAMILINE["href=""http"
"RTN","SAMIFLD",441,0)
 . quit:SAMILINE["/vapals"
"RTN","SAMIFLD",442,0)
 . if SAMILINE["href=""/" do  quit
"RTN","SAMIFLD",443,0)
 . . do findReplaceAll^%ts(.SAMILINE,"href=""/","href=""/","href=""/see/sami/")
"RTN","SAMIFLD",444,0)
 . . quit
"RTN","SAMIFLD",445,0)
 . if SAMILINE["href=""" do  quit
"RTN","SAMIFLD",446,0)
 . . do findReplaceAll^%ts(.SAMILINE,"href=""","href=""/see/sami/")
"RTN","SAMIFLD",447,0)
 . . quit
"RTN","SAMIFLD",448,0)
 . if SAMILINE["href=" do  quit
"RTN","SAMIFLD",449,0)
 . . do findReplaceAll^%ts(.SAMILINE,"href=","href=/see/sami/")
"RTN","SAMIFLD",450,0)
 . . quit
"RTN","SAMIFLD",451,0)
 . quit
"RTN","SAMIFLD",452,0)
 ;
"RTN","SAMIFLD",453,0)
 quit  ; end of ppi FIXHREF^SAMIFORM
"RTN","SAMIFLD",454,0)
 ;
"RTN","SAMIFLD",455,0)
 ;
"RTN","SAMIFLD",456,0)
 ;
"RTN","SAMIFLD",457,0)
 ;@section 3 code for ppis $$GETNAME^SAMIFORM,$$GETSSN^SAMIFORM
"RTN","SAMIFLD",458,0)
 ;
"RTN","SAMIFLD",459,0)
 ;
"RTN","SAMIFLD",460,0)
 ;
"RTN","SAMIFLD",461,0)
 ;@ppi-code $$GETNAME^SAMIFORM
"RTN","SAMIFLD",462,0)
GETNAME ; name for patient sid
"RTN","SAMIFLD",463,0)
 ;
"RTN","SAMIFLD",464,0)
 ;@signature
"RTN","SAMIFLD",465,0)
 ; $$GETNAME^SAMIFORM(sid)
"RTN","SAMIFLD",466,0)
 ;@branches-from
"RTN","SAMIFLD",467,0)
 ; GETNAME^SAMIFORM
"RTN","SAMIFLD",468,0)
 ;@ppi-called-by
"RTN","SAMIFLD",469,0)
 ; WSCASE^SAMICAS2
"RTN","SAMIFLD",470,0)
 ;@called-by: none
"RTN","SAMIFLD",471,0)
 ;@calls
"RTN","SAMIFLD",472,0)
 ; $$setroot^%wd
"RTN","SAMIFLD",473,0)
 ;@input
"RTN","SAMIFLD",474,0)
 ; sid = patient study id
"RTN","SAMIFLD",475,0)
 ;@output = patient's name
"RTN","SAMIFLD",476,0)
 ;@tests
"RTN","SAMIFLD",477,0)
 ; UTGTNM^SAMIUTF2: name for patient sid
"RTN","SAMIFLD",478,0)
 ;
"RTN","SAMIFLD",479,0)
 quit:$get(sid)="" ""
"RTN","SAMIFLD",480,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMIFLD",481,0)
 new ien set ien=$order(@root@("sid",sid,""))
"RTN","SAMIFLD",482,0)
 quit:ien=""
"RTN","SAMIFLD",483,0)
 ;
"RTN","SAMIFLD",484,0)
 quit @root@(ien,"saminame") ; end of ppi $$GETNAME^SAMIFORM
"RTN","SAMIFLD",485,0)
 ;
"RTN","SAMIFLD",486,0)
 ;
"RTN","SAMIFLD",487,0)
 ;
"RTN","SAMIFLD",488,0)
 ;@ppi-code $$GETSSN^SAMIFORM
"RTN","SAMIFLD",489,0)
GETSSN ; ssn for patient sid
"RTN","SAMIFLD",490,0)
 ;
"RTN","SAMIFLD",491,0)
 ;@signature
"RTN","SAMIFLD",492,0)
 ; $$GETSSN^SAMIFORM(sid)
"RTN","SAMIFLD",493,0)
 ;@branches-from
"RTN","SAMIFLD",494,0)
 ; GETSSN^SAMIFORM
"RTN","SAMIFLD",495,0)
 ;@ppi-called-by
"RTN","SAMIFLD",496,0)
 ; WSCASE^SAMICAS2
"RTN","SAMIFLD",497,0)
 ;@called-by: none
"RTN","SAMIFLD",498,0)
 ;@calls
"RTN","SAMIFLD",499,0)
 ; $$setroot^%wd
"RTN","SAMIFLD",500,0)
 ;@input
"RTN","SAMIFLD",501,0)
 ; sid = patient study id
"RTN","SAMIFLD",502,0)
 ;@output = patient's ssn
"RTN","SAMIFLD",503,0)
 ;@tests
"RTN","SAMIFLD",504,0)
 ; UTGSSN^SAMIUTF2: ssn for patient sid
"RTN","SAMIFLD",505,0)
 ;
"RTN","SAMIFLD",506,0)
 quit:$get(sid)="" ""
"RTN","SAMIFLD",507,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMIFLD",508,0)
 new ien set ien=$order(@root@("sid",sid,""))
"RTN","SAMIFLD",509,0)
 quit:ien=""
"RTN","SAMIFLD",510,0)
 ;
"RTN","SAMIFLD",511,0)
 new pssn set pssn=$get(@root@(ien,"sissn"))
"RTN","SAMIFLD",512,0)
 if pssn["sta" set pssn=""
"RTN","SAMIFLD",513,0)
 if pssn="" do  ;
"RTN","SAMIFLD",514,0)
 . new orgssn set orgssn=$get(@root@(ien,"ssn"))
"RTN","SAMIFLD",515,0)
 . quit:orgssn=""
"RTN","SAMIFLD",516,0)
 . set pssn=$extract(orgssn,1,3)_"-"_$extract(orgssn,4,5)_"-"_$extract(orgssn,6,9)
"RTN","SAMIFLD",517,0)
 . set @root@(ien,"sissn")=pssn
"RTN","SAMIFLD",518,0)
 . quit
"RTN","SAMIFLD",519,0)
 ;
"RTN","SAMIFLD",520,0)
 quit pssn ; end of $$GETSSN^SAMIFORM
"RTN","SAMIFLD",521,0)
 ;
"RTN","SAMIFLD",522,0)
GETPRFX ; Retrieve study ID prefix from parameter file
"RTN","SAMIFLD",523,0)
 ; This routine is depricated as of the multi-tenancy features
"RTN","SAMIFLD",524,0)
 ;
"RTN","SAMIFLD",525,0)
 ;@signature
"RTN","SAMIFLD",526,0)
 ; $$GETPRFX^SAMIFORM()
"RTN","SAMIFLD",527,0)
 ;@branches-from
"RTN","SAMIFLD",528,0)
 ; GETPRFX^SAMIFORM
"RTN","SAMIFLD",529,0)
 ;@ppi-called-by
"RTN","SAMIFLD",530,0)
 ; WSCASE^SAMICAS2
"RTN","SAMIFLD",531,0)
 ;@calls
"RTN","SAMIFLD",532,0)
 ; $$GET^XPAR
"RTN","SAMIFLD",533,0)
 ;@output = patient's ssn
"RTN","SAMIFLD",534,0)
 ;@tests
"RTN","SAMIFLD",535,0)
 ; None yet
"RTN","SAMIFLD",536,0)
 ;
"RTN","SAMIFLD",537,0)
 new prefix
"RTN","SAMIFLD",538,0)
 ;set prefix=$$GET^XPAR("SYS","SAMI SID PREFIX",,"Q")
"RTN","SAMIFLD",539,0)
 s prefix=$g(ARG("siteid"))
"RTN","SAMIFLD",540,0)
 i prefix="" s prefix=$g(ARG("site"))
"RTN","SAMIFLD",541,0)
 if $get(prefix)="" set prefix="UNK"
"RTN","SAMIFLD",542,0)
 ;
"RTN","SAMIFLD",543,0)
 quit prefix ; End of $$GETPRFX^SAMIFORM
"RTN","SAMIFLD",544,0)
 ;
"RTN","SAMIFLD",545,0)
 ;
"RTN","SAMIFLD",546,0)
EOR ; end of routine SAMIFLD
"RTN","SAMIFORM")
0^1^B4892541
"RTN","SAMIFORM",1,0)
SAMIFORM ;ven/gpl - ielcap: form library ; 2019-08-01T15:42Z
"RTN","SAMIFORM",2,0)
 ;;18.0;SAMI;;;Build 12
"RTN","SAMIFORM",3,0)
 ;
"RTN","SAMIFORM",4,0)
 ; Routine SAMIFORM contains the vapals-elcap form library.
"RTN","SAMIFORM",5,0)
 ; SAMIFORM contains private program interfaces, direct-mode
"RTN","SAMIFORM",6,0)
 ; interfaces, and web-service interfaces.
"RTN","SAMIFORM",7,0)
 ; It contains no public entry points.
"RTN","SAMIFORM",8,0)
 ;
"RTN","SAMIFORM",9,0)
 quit  ; no entry from top
"RTN","SAMIFORM",10,0)
 ;
"RTN","SAMIFORM",11,0)
 ;
"RTN","SAMIFORM",12,0)
 ;
"RTN","SAMIFORM",13,0)
 ;@section 0 primary development
"RTN","SAMIFORM",14,0)
 ;
"RTN","SAMIFORM",15,0)
 ;
"RTN","SAMIFORM",16,0)
 ;
"RTN","SAMIFORM",17,0)
 ;@routine-credits
"RTN","SAMIFORM",18,0)
 ;@primary-dev: George P. Lilly (gpl)
"RTN","SAMIFORM",19,0)
 ; gpl@vistaexpertise.net
"RTN","SAMIFORM",20,0)
 ;@primary-dev-org: Vista Expertise Network (ven)
"RTN","SAMIFORM",21,0)
 ; http://vistaexpertise.net
"RTN","SAMIFORM",22,0)
 ;@copyright: 2017/2019, gpl, all rights reserved
"RTN","SAMIFORM",23,0)
 ;@license: Apache 2.0
"RTN","SAMIFORM",24,0)
 ; https://www.apache.org/licenses/LICENSE-2.0.html
"RTN","SAMIFORM",25,0)
 ;
"RTN","SAMIFORM",26,0)
 ;@last-updated: 2019-08-01T15:42Z
"RTN","SAMIFORM",27,0)
 ;@application: Screening Applications Management (SAM)
"RTN","SAMIFORM",28,0)
 ;@module: Screening Applications Management - VAPALS-ELCAP (SAMI)
"RTN","SAMIFORM",29,0)
 ;@version: 18.0T04 (fourth development version)
"RTN","SAMIFORM",30,0)
 ;@release-date: not yet released
"RTN","SAMIFORM",31,0)
 ;@patch-list: none yet
"RTN","SAMIFORM",32,0)
 ;
"RTN","SAMIFORM",33,0)
 ;@additional-dev: Frederick D. S. Marshall (toad)
"RTN","SAMIFORM",34,0)
 ; toad@vistaexpertise.net
"RTN","SAMIFORM",35,0)
 ;@additional-dev: Larry G. Carlson (lgc)
"RTN","SAMIFORM",36,0)
 ; lgc@vistaexpertise.net
"RTN","SAMIFORM",37,0)
 ;@additional-dev: Alexis Carlson (arc)
"RTN","SAMIFORM",38,0)
 ; alexis.carlson@vistaexpertise.net
"RTN","SAMIFORM",39,0)
 ;
"RTN","SAMIFORM",40,0)
 ;@module-credits [see SAMIFUL]
"RTN","SAMIFORM",41,0)
 ;
"RTN","SAMIFORM",42,0)
 ;@contents
"RTN","SAMIFORM",43,0)
 ; LOAD: ppi, process html line, e.g., load json data into graph
"RTN","SAMIFORM",44,0)
 ;
"RTN","SAMIFORM",45,0)
 ; $$GETLAST5 = ppi, last5 for patient sid
"RTN","SAMIFORM",46,0)
 ; FIXSRC: ppi, fix html src lines to use resources in see/
"RTN","SAMIFORM",47,0)
 ; FIXHREF: ppi, fix html href lines to use resources in see/
"RTN","SAMIFORM",48,0)
 ;
"RTN","SAMIFORM",49,0)
 ; $$GETNAME = ppi, name for patient sid
"RTN","SAMIFORM",50,0)
 ; $$GETSSN = ppi, ssn for patient sid
"RTN","SAMIFORM",51,0)
 ;
"RTN","SAMIFORM",52,0)
 ; INIT: dmi, initialize all available forms
"RTN","SAMIFORM",53,0)
 ; REGISTER: dmi, register elcap forms in form mapping file
"RTN","SAMIFORM",54,0)
 ; IMPORT: dmi, import json-data directory into elcap-patient graph
"RTN","SAMIFORM",55,0)
 ;
"RTN","SAMIFORM",56,0)
 ; WSSBFORM: wsi GET background, background form access
"RTN","SAMIFORM",57,0)
 ; WSSIFORM: wsi GET intake, intake form access
"RTN","SAMIFORM",58,0)
 ; WSCEFORM: wsi GET ctevaluation, ctevaluation form access
"RTN","SAMIFORM",59,0)
 ;
"RTN","SAMIFORM",60,0)
 ;
"RTN","SAMIFORM",61,0)
 ;
"RTN","SAMIFORM",62,0)
 ;@section 1 form-load & case-review private program interfaces
"RTN","SAMIFORM",63,0)
 ;
"RTN","SAMIFORM",64,0)
 ;
"RTN","SAMIFORM",65,0)
 ;
"RTN","SAMIFORM",66,0)
 ;@ppi LOAD^SAMIFORM, process html line, e.g., load json data into graph
"RTN","SAMIFORM",67,0)
LOAD(SAMILINE,form,sid,SAMIFILTER,SAMILNUM,SAMIHTML,SAMIVALS) goto LOAD^SAMIFLD
"RTN","SAMIFORM",68,0)
 ;
"RTN","SAMIFORM",69,0)
 ;
"RTN","SAMIFORM",70,0)
 ;
"RTN","SAMIFORM",71,0)
 ;@ppi $$GETLAST5^SAMIFORM, last5 for patient sid
"RTN","SAMIFORM",72,0)
GETLAST5(sid) goto GETLAST5^SAMIFLD
"RTN","SAMIFORM",73,0)
 ;
"RTN","SAMIFORM",74,0)
 ;
"RTN","SAMIFORM",75,0)
 ;
"RTN","SAMIFORM",76,0)
 ;@ppi FIXSRC^SAMIFORM, fix html src lines to use resources in see/
"RTN","SAMIFORM",77,0)
FIXSRC(SAMILINE) goto FIXSRC^SAMIFLD
"RTN","SAMIFORM",78,0)
 ;
"RTN","SAMIFORM",79,0)
 ;
"RTN","SAMIFORM",80,0)
 ;
"RTN","SAMIFORM",81,0)
 ;@ppi FIXHREF^SAMIFORM, fix html href lines to use resources in see/
"RTN","SAMIFORM",82,0)
FIXHREF(SAMILINE) goto FIXHREF^SAMIFLD
"RTN","SAMIFORM",83,0)
 ;
"RTN","SAMIFORM",84,0)
 ;
"RTN","SAMIFORM",85,0)
 ;
"RTN","SAMIFORM",86,0)
 ;@ppi-code $$GETNAME^SAMIFORM, name for patient sid
"RTN","SAMIFORM",87,0)
GETNAME(sid) goto GETNAME^SAMIFLD
"RTN","SAMIFORM",88,0)
 ;
"RTN","SAMIFORM",89,0)
 ;
"RTN","SAMIFORM",90,0)
 ;
"RTN","SAMIFORM",91,0)
 ;@ppi-code $$GETSSN^SAMIFORM, ssn for patient sid
"RTN","SAMIFORM",92,0)
GETSSN(sid) goto GETSSN^SAMIFLD
"RTN","SAMIFORM",93,0)
 ;
"RTN","SAMIFORM",94,0)
 ;
"RTN","SAMIFORM",95,0)
 ;
"RTN","SAMIFORM",96,0)
 ;@ppi-code $$GETPRFX^SAMIFORM, prefix for study ID
"RTN","SAMIFORM",97,0)
 ; this routine is depricated as of the multi-tenancy release
"RTN","SAMIFORM",98,0)
GETPRFX(ARG) goto GETPRFX^SAMIFLD
"RTN","SAMIFORM",99,0)
 ;
"RTN","SAMIFORM",100,0)
 ;
"RTN","SAMIFORM",101,0)
 ;
"RTN","SAMIFORM",102,0)
 ;@section 2 direct-mode interfaces
"RTN","SAMIFORM",103,0)
 ;
"RTN","SAMIFORM",104,0)
 ;
"RTN","SAMIFORM",105,0)
 ;
"RTN","SAMIFORM",106,0)
 ;@dmi INIT^SAMIFORM, initilize all available forms
"RTN","SAMIFORM",107,0)
INIT goto INIT^SAMIFDM
"RTN","SAMIFORM",108,0)
 ;
"RTN","SAMIFORM",109,0)
 ;
"RTN","SAMIFORM",110,0)
 ;
"RTN","SAMIFORM",111,0)
 ;@dmi REGISTER^SAMIFORM, register elcap forms in form mapping file
"RTN","SAMIFORM",112,0)
REGISTER goto REGISTER^SAMIFDM
"RTN","SAMIFORM",113,0)
 ;
"RTN","SAMIFORM",114,0)
 ;
"RTN","SAMIFORM",115,0)
 ;
"RTN","SAMIFORM",116,0)
 ;@dmi IMPORT^SAMIFORM, import json-data directory into elcap-patient graph
"RTN","SAMIFORM",117,0)
IMPORT goto IMPORT^SAMIFDM
"RTN","SAMIFORM",118,0)
 ;
"RTN","SAMIFORM",119,0)
 ;
"RTN","SAMIFORM",120,0)
 ;
"RTN","SAMIFORM",121,0)
 ;@section 3 web-service interfaces
"RTN","SAMIFORM",122,0)
 ;
"RTN","SAMIFORM",123,0)
 ;
"RTN","SAMIFORM",124,0)
 ;
"RTN","SAMIFORM",125,0)
 ;@debug old wsi GET background, background form access
"RTN","SAMIFORM",126,0)
WSSBFORM(SAMIRTN,SAMIFILTER) goto WSSBFORM^SAMIFWS
"RTN","SAMIFORM",127,0)
 ;
"RTN","SAMIFORM",128,0)
 ;
"RTN","SAMIFORM",129,0)
 ;
"RTN","SAMIFORM",130,0)
 ;@debug old wsi GET intake, intake form access
"RTN","SAMIFORM",131,0)
WSSIFORM(SAMIRTN,SAMIFILTER) goto WSSIFORM^SAMIFWS
"RTN","SAMIFORM",132,0)
 ;
"RTN","SAMIFORM",133,0)
 ;
"RTN","SAMIFORM",134,0)
 ;
"RTN","SAMIFORM",135,0)
 ;@debug old wsi GET ctevaluation, ctevaluation form access
"RTN","SAMIFORM",136,0)
WSCEFORM(SAMIRTN,SAMIFILTER) goto WSCEFORM^SAMIFWS
"RTN","SAMIFORM",137,0)
 ;
"RTN","SAMIFORM",138,0)
 ;
"RTN","SAMIFORM",139,0)
 ;
"RTN","SAMIFORM",140,0)
EOR ; end of routine SAMIFORM
"RTN","SAMIFWS")
0^2^B13804779
"RTN","SAMIFWS",1,0)
SAMIFWS ;ven/gpl - elcap: form debugging web services ; 4/22/19 12:25pm
"RTN","SAMIFWS",2,0)
 ;;18.0;SAMI;;;Build 12
"RTN","SAMIFWS",3,0)
 ;
"RTN","SAMIFWS",4,0)
 ; Routine SAMIFWS contains debugging subroutines that implement web
"RTN","SAMIFWS",5,0)
 ; services not needed in production but useful when troubleshooting.
"RTN","SAMIFWS",6,0)
 ; These form-specific web services for accessing the intake, background,
"RTN","SAMIFWS",7,0)
 ; and ct evaluation forms have been replaced in production by web
"RTN","SAMIFWS",8,0)
 ; service POST vapals, which handles all forms and reports now in the
"RTN","SAMIFWS",9,0)
 ; production application.
"RTN","SAMIFWS",10,0)
 ;
"RTN","SAMIFWS",11,0)
 ; When debugging problems with the forms it can be very useful to call
"RTN","SAMIFWS",12,0)
 ; them directly, bypassing the rest of the POST vapals logic. At such
"RTN","SAMIFWS",13,0)
 ; times, just recreate the record in file Web Service URl Handler for
"RTN","SAMIFWS",14,0)
 ; the form you want to call directly, use that to debug the form, and
"RTN","SAMIFWS",15,0)
 ; then when the problem has been resolved delete the record again.
"RTN","SAMIFWS",16,0)
 ;
"RTN","SAMIFWS",17,0)
 ; SAMIFWS contains no public entry points (see SAMIFORM).
"RTN","SAMIFWS",18,0)
 ;
"RTN","SAMIFWS",19,0)
 quit  ; no entry from top
"RTN","SAMIFWS",20,0)
 ;
"RTN","SAMIFWS",21,0)
 ;
"RTN","SAMIFWS",22,0)
 ;
"RTN","SAMIFWS",23,0)
 ;@section 0 primary development
"RTN","SAMIFWS",24,0)
 ;
"RTN","SAMIFWS",25,0)
 ;
"RTN","SAMIFWS",26,0)
 ;
"RTN","SAMIFWS",27,0)
 ;@routine-credits
"RTN","SAMIFWS",28,0)
 ;@primary-dev: George P. Lilly (gpl)
"RTN","SAMIFWS",29,0)
 ; gpl@vistaexpertise.net
"RTN","SAMIFWS",30,0)
 ;@primary-dev-org: Vista Expertise Network (ven)
"RTN","SAMIFWS",31,0)
 ; http://vistaexpertise.net
"RTN","SAMIFWS",32,0)
 ;@copyright: 2017/2019, gpl, all rights reserved
"RTN","SAMIFWS",33,0)
 ;@license: Apache 2.0
"RTN","SAMIFWS",34,0)
 ; https://www.apache.org/licenses/LICENSE-2.0.html
"RTN","SAMIFWS",35,0)
 ;
"RTN","SAMIFWS",36,0)
 ;@last-updated: 2019-01-08T20:59Z
"RTN","SAMIFWS",37,0)
 ;@application: Screening Applications Management (SAM)
"RTN","SAMIFWS",38,0)
 ;@module: Screening Applications Management - VAPALS-ELCAP (SAMI)
"RTN","SAMIFWS",39,0)
 ;@version: 18.0T04 (fourth development version)
"RTN","SAMIFWS",40,0)
 ;@release-date: not yet released
"RTN","SAMIFWS",41,0)
 ;@patch-list: none yet
"RTN","SAMIFWS",42,0)
 ;
"RTN","SAMIFWS",43,0)
 ;@additional-dev: Frederick D. S. Marshall (toad)
"RTN","SAMIFWS",44,0)
 ; toad@vistaexpertise.net
"RTN","SAMIFWS",45,0)
 ;@additional-dev: Larry G. Carlson (lgc)
"RTN","SAMIFWS",46,0)
 ; lgc@vistaexpertise.net
"RTN","SAMIFWS",47,0)
 ;
"RTN","SAMIFWS",48,0)
 ;@module-credits [see SAMIFUL]
"RTN","SAMIFWS",49,0)
 ;
"RTN","SAMIFWS",50,0)
 ;@contents
"RTN","SAMIFWS",51,0)
 ; 
"RTN","SAMIFWS",52,0)
 ;
"RTN","SAMIFWS",53,0)
 ;@to-do
"RTN","SAMIFWS",54,0)
 ; add dmis to create & delete each form's debugging web service
"RTN","SAMIFWS",55,0)
 ;
"RTN","SAMIFWS",56,0)
 ;
"RTN","SAMIFWS",57,0)
 ;
"RTN","SAMIFWS",58,0)
 ;@section 1 code for web service interfaces
"RTN","SAMIFWS",59,0)
 ;
"RTN","SAMIFWS",60,0)
 ;
"RTN","SAMIFWS",61,0)
 ;
"RTN","SAMIFWS",62,0)
 ;@debug old wsi GET background
"RTN","SAMIFWS",63,0)
WSSBFORM ; background form access
"RTN","SAMIFWS",64,0)
 ;
"RTN","SAMIFWS",65,0)
 ;@signature
"RTN","SAMIFWS",66,0)
 ; do WSSBFORM^SAMIFORM(.SAMIRTN,.SAMIFILTER)
"RTN","SAMIFWS",67,0)
 ;@branches-from
"RTN","SAMIFWS",68,0)
 ; WSSBFORM^SAMIFORM
"RTN","SAMIFWS",69,0)
 ;@ppi-called-by: none [only when debugging]
"RTN","SAMIFWS",70,0)
 ;@called-by: none
"RTN","SAMIFWS",71,0)
 ;@calls
"RTN","SAMIFWS",72,0)
 ; $$GENSTDID^SAMIHOM3
"RTN","SAMIFWS",73,0)
 ; GETITEMS^SAMICAS2
"RTN","SAMIFWS",74,0)
 ; wsGetForm^%wf
"RTN","SAMIFWS",75,0)
 ;@thruput
"RTN","SAMIFWS",76,0)
 ;.SAMIRTN = name of root containing returned html (the prepared form)
"RTN","SAMIFWS",77,0)
 ;.SAMIFILTER = work-parameters array
"RTN","SAMIFWS",78,0)
 ; SAMIFILTER("debug") = 1 to debug some fields, 2 to debug more fields
"RTN","SAMIFWS",79,0)
 ; SAMIFILTER("errormessagestyle") = 2 (default) = use current error msg style
"RTN","SAMIFWS",80,0)
 ; SAMIFILTER("form") = form id (e.g., "vapals:sbform")
"RTN","SAMIFWS",81,0)
 ; SAMIFILTER("key") = graph key for saved form (e.g., "sbform-2019-07-01")
"RTN","SAMIFWS",82,0)
 ; SAMIFILTER("studyid") = patient study id (e.g., "XXX00045")
"RTN","SAMIFWS",83,0)
 ; SAMIFILTER("fvalue") = deprecated
"RTN","SAMIFWS",84,0)
 ;@tests
"RTN","SAMIFWS",85,0)
 ; UTWSSBF^SAMIUTF: background form access
"RTN","SAMIFWS",86,0)
 ;
"RTN","SAMIFWS",87,0)
 ; This was the old GET background web service, before ws POST vapals
"RTN","SAMIFWS",88,0)
 ; took over all form get and post functions. It is kept as a debugging
"RTN","SAMIFWS",89,0)
 ; tool.
"RTN","SAMIFWS",90,0)
 ;
"RTN","SAMIFWS",91,0)
 ; To recreate this web service for debugging, edit file Web Service URL
"RTN","SAMIFWS",92,0)
 ; Handler (17.6001) to create a new record with the following field
"RTN","SAMIFWS",93,0)
 ; values:
"RTN","SAMIFWS",94,0)
 ;
"RTN","SAMIFWS",95,0)
 ; field HTTP Verb (.01): GET
"RTN","SAMIFWS",96,0)
 ; field URI (1): background
"RTN","SAMIFWS",97,0)
 ; field Execution Endpoint (2): WSSBFORM^SAMIFORM
"RTN","SAMIFWS",98,0)
 ;
"RTN","SAMIFWS",99,0)
 ; When finished debugging, delete the record from the file.
"RTN","SAMIFWS",100,0)
 ;
"RTN","SAMIFWS",101,0)
 new sid set sid=$get(SAMIFILTER("studyid"))
"RTN","SAMIFWS",102,0)
 set:sid="" sid=$get(SAMIFILTER("sid"))
"RTN","SAMIFWS",103,0)
 set:sid>0 sid=$$GENSTDID^SAMIHOM3(sid)
"RTN","SAMIFWS",104,0)
 ; if sid="" set sid="XXX0001"
"RTN","SAMIFWS",105,0)
 ;
"RTN","SAMIFWS",106,0)
 ;new items do GETITEMS^SAMICAS2("items",sid)
"RTN","SAMIFWS",107,0)
 ; write !,"sid=",sid,!
"RTN","SAMIFWS",108,0)
 ; zwrite items
"RTN","SAMIFWS",109,0)
 ; break
"RTN","SAMIFWS",110,0)
 ;
"RTN","SAMIFWS",111,0)
 new key set key=$order(items("sbfor"))
"RTN","SAMIFWS",112,0)
 set SAMIFILTER("key")=key
"RTN","SAMIFWS",113,0)
 set SAMIFILTER("form")="vapals:sbform"
"RTN","SAMIFWS",114,0)
 do wsGetForm^%wf(.SAMIRTN,.SAMIFILTER)
"RTN","SAMIFWS",115,0)
 ;
"RTN","SAMIFWS",116,0)
 quit  ; end of WSSBFORM^SAMIFORM
"RTN","SAMIFWS",117,0)
 ;
"RTN","SAMIFWS",118,0)
 ;
"RTN","SAMIFWS",119,0)
 ;
"RTN","SAMIFWS",120,0)
 ;@debug old wsi GET intake
"RTN","SAMIFWS",121,0)
WSSIFORM ; intake form access
"RTN","SAMIFWS",122,0)
 ;
"RTN","SAMIFWS",123,0)
 ;@signature
"RTN","SAMIFWS",124,0)
 ; do WSSIFORM^SAMIFORM(.SAMIRTN,.SAMIFILTER)
"RTN","SAMIFWS",125,0)
 ;@branches-from
"RTN","SAMIFWS",126,0)
 ; WSSIFORM^SAMIFORM
"RTN","SAMIFWS",127,0)
 ;@ppi-called-by: none [only when debugging]
"RTN","SAMIFWS",128,0)
 ;@called-by: none
"RTN","SAMIFWS",129,0)
 ;@calls
"RTN","SAMIFWS",130,0)
 ; $$GENSTDID^SAMIHOM3
"RTN","SAMIFWS",131,0)
 ; GETITEMS^SAMICAS2
"RTN","SAMIFWS",132,0)
 ; wsGetForm^%wf
"RTN","SAMIFWS",133,0)
 ;@thruput
"RTN","SAMIFWS",134,0)
 ;.SAMIRTN = name of root containing returned html (the prepared form)
"RTN","SAMIFWS",135,0)
 ;.SAMIFILTER = work-parameters array
"RTN","SAMIFWS",136,0)
 ; SAMIFILTER("debug") = 1 to debug some fields, 2 to debug more fields
"RTN","SAMIFWS",137,0)
 ; SAMIFILTER("errormessagestyle") = 2 (default) = use current error msg style
"RTN","SAMIFWS",138,0)
 ; SAMIFILTER("form") = form id (e.g., "vapals:siform")
"RTN","SAMIFWS",139,0)
 ; SAMIFILTER("key") = graph key for saved form (e.g., "siform-2019-07-01")
"RTN","SAMIFWS",140,0)
 ; SAMIFILTER("studyid") = patient study id (e.g., "XXX00045")
"RTN","SAMIFWS",141,0)
 ; SAMIFILTER("fvalue") = deprecated
"RTN","SAMIFWS",142,0)
 ;@tests
"RTN","SAMIFWS",143,0)
 ; UTWSIFM^SAMIUTF: intake form access
"RTN","SAMIFWS",144,0)
 ;
"RTN","SAMIFWS",145,0)
 ; This was the old GET intake web service, before ws POST vapals
"RTN","SAMIFWS",146,0)
 ; took over all form get and post functions. It is kept as a debugging
"RTN","SAMIFWS",147,0)
 ; tool.
"RTN","SAMIFWS",148,0)
 ;
"RTN","SAMIFWS",149,0)
 ; To recreate this web service for debugging, edit file Web Service URL
"RTN","SAMIFWS",150,0)
 ; Handler (17.6001) to create a new record with the following field
"RTN","SAMIFWS",151,0)
 ; values:
"RTN","SAMIFWS",152,0)
 ;
"RTN","SAMIFWS",153,0)
 ; field HTTP Verb (.01): GET
"RTN","SAMIFWS",154,0)
 ; field URI (1): intake
"RTN","SAMIFWS",155,0)
 ; field Execution Endpoint (2): WSSIFORM^SAMIFORM
"RTN","SAMIFWS",156,0)
 ;
"RTN","SAMIFWS",157,0)
 ; When finished debugging, delete the record from the file.
"RTN","SAMIFWS",158,0)
 ;
"RTN","SAMIFWS",159,0)
 new sid set sid=$get(SAMIFILTER("studyid"))
"RTN","SAMIFWS",160,0)
 set:sid="" sid=$get(SAMIFILTER("sid"))
"RTN","SAMIFWS",161,0)
 set:sid>0 sid=$$GENSTDID^SAMIHOM3(sid,.SAMIFILTER)
"RTN","SAMIFWS",162,0)
 ; if sid="" set sid="XXX0001"
"RTN","SAMIFWS",163,0)
 ;
"RTN","SAMIFWS",164,0)
 ;new items do GETITEMS^SAMICAS2("items",sid)
"RTN","SAMIFWS",165,0)
 ; write !,"sid=",sid,!
"RTN","SAMIFWS",166,0)
 ; zwrite items
"RTN","SAMIFWS",167,0)
 ; break
"RTN","SAMIFWS",168,0)
 ;
"RTN","SAMIFWS",169,0)
 new key set key=$order(items("sifor"))
"RTN","SAMIFWS",170,0)
 set SAMIFILTER("key")=key
"RTN","SAMIFWS",171,0)
 set SAMIFILTER("form")="vapals:siform"
"RTN","SAMIFWS",172,0)
 do wsGetForm^%wf(.SAMIRTN,.SAMIFILTER)
"RTN","SAMIFWS",173,0)
 ;
"RTN","SAMIFWS",174,0)
 quit  ; end of WSSIFORM^SAMIFORM
"RTN","SAMIFWS",175,0)
 ;
"RTN","SAMIFWS",176,0)
 ;
"RTN","SAMIFWS",177,0)
 ;
"RTN","SAMIFWS",178,0)
 ;@debug old wsi GET ctevaluation
"RTN","SAMIFWS",179,0)
WSCEFORM ; ctevaluation form access
"RTN","SAMIFWS",180,0)
 ;
"RTN","SAMIFWS",181,0)
 ;@signature
"RTN","SAMIFWS",182,0)
 ; do WSCEFORM^SAMIFORM(.SAMIRTN,.SAMIFILTER)
"RTN","SAMIFWS",183,0)
 ;@branches-from
"RTN","SAMIFWS",184,0)
 ; WSCEFORM^SAMIFORM
"RTN","SAMIFWS",185,0)
 ;@ppi-called-by: none [only when debugging]
"RTN","SAMIFWS",186,0)
 ;@called-by: none
"RTN","SAMIFWS",187,0)
 ;@calls
"RTN","SAMIFWS",188,0)
 ; $$GENSTDID^SAMIHOM3
"RTN","SAMIFWS",189,0)
 ; GETITEMS^SAMICAS2
"RTN","SAMIFWS",190,0)
 ; wsGetForm^%wf
"RTN","SAMIFWS",191,0)
 ;@thruput
"RTN","SAMIFWS",192,0)
 ;.SAMIRTN = name of root containing returned html (the prepared form)
"RTN","SAMIFWS",193,0)
 ;.SAMIFILTER = work-parameters array
"RTN","SAMIFWS",194,0)
 ; SAMIFILTER("debug") = 1 to debug some fields, 2 to debug more fields
"RTN","SAMIFWS",195,0)
 ; SAMIFILTER("errormessagestyle") = 2 (default) = use current error msg style
"RTN","SAMIFWS",196,0)
 ; SAMIFILTER("form") = form id (e.g., "vapals:ceform")
"RTN","SAMIFWS",197,0)
 ; SAMIFILTER("key") = graph key for saved form (e.g., "ceform-2019-07-01")
"RTN","SAMIFWS",198,0)
 ; SAMIFILTER("studyid") = patient study id (e.g., "XXX00045")
"RTN","SAMIFWS",199,0)
 ; SAMIFILTER("fvalue") = deprecated
"RTN","SAMIFWS",200,0)
 ;@tests
"RTN","SAMIFWS",201,0)
 ; UTCEFRM^SAMIUTF: ctevaluation form access
"RTN","SAMIFWS",202,0)
 ;
"RTN","SAMIFWS",203,0)
 ; This was the old GET ctevaluation web service, before ws POST vapals
"RTN","SAMIFWS",204,0)
 ; took over all form get and post functions. It is kept as a debugging
"RTN","SAMIFWS",205,0)
 ; tool.
"RTN","SAMIFWS",206,0)
 ;
"RTN","SAMIFWS",207,0)
 ; To recreate this web service for debugging, edit file Web Service URL
"RTN","SAMIFWS",208,0)
 ; Handler (17.6001) to create a new record with the following field
"RTN","SAMIFWS",209,0)
 ; values:
"RTN","SAMIFWS",210,0)
 ;
"RTN","SAMIFWS",211,0)
 ; field HTTP Verb (.01): GET
"RTN","SAMIFWS",212,0)
 ; field URI (1): ctevaluation
"RTN","SAMIFWS",213,0)
 ; field Execution Endpoint (2): WSCEFORM^SAMIFORM
"RTN","SAMIFWS",214,0)
 ;
"RTN","SAMIFWS",215,0)
 ; When finished debugging, delete the record from the file.
"RTN","SAMIFWS",216,0)
 ;
"RTN","SAMIFWS",217,0)
 new sid set sid=$get(SAMIFILTER("studyid"))
"RTN","SAMIFWS",218,0)
 set:sid="" sid=$get(SAMIFILTER("sid"))
"RTN","SAMIFWS",219,0)
 set:sid>0 sid=$$GENSTDID^SAMIHOM3(sid)
"RTN","SAMIFWS",220,0)
 ; if sid="" set sid="XXX0001"
"RTN","SAMIFWS",221,0)
 ;
"RTN","SAMIFWS",222,0)
 ;new items do GETITEMS^SAMICAS2("items",sid)
"RTN","SAMIFWS",223,0)
 ; write !,"sid=",sid,!
"RTN","SAMIFWS",224,0)
 ; zwrite items
"RTN","SAMIFWS",225,0)
 ; break
"RTN","SAMIFWS",226,0)
 ;
"RTN","SAMIFWS",227,0)
 new key set key=$order(items("cefor"))
"RTN","SAMIFWS",228,0)
 set SAMIFILTER("key")=key
"RTN","SAMIFWS",229,0)
 set SAMIFILTER("form")="vapals:ceform"
"RTN","SAMIFWS",230,0)
 do wsGetForm^%wf(.SAMIRTN,.SAMIFILTER)
"RTN","SAMIFWS",231,0)
 ;
"RTN","SAMIFWS",232,0)
 quit  ; end of WSCEFORM^SAMIFORM
"RTN","SAMIFWS",233,0)
 ;
"RTN","SAMIFWS",234,0)
 ;
"RTN","SAMIFWS",235,0)
 ;
"RTN","SAMIFWS",236,0)
EOR ; end of routine SAMIFWS
"RTN","SAMIHOM3")
0^3^B133868845
"RTN","SAMIHOM3",1,0)
SAMIHOM3 ;ven/gpl - ielcap: forms ; 2019-08-07T01:13Z
"RTN","SAMIHOM3",2,0)
 ;;18.0;SAMI;;;Build 12
"RTN","SAMIHOM3",3,0)
 ;
"RTN","SAMIHOM3",4,0)
 ;@license: see routine SAMIUL
"RTN","SAMIHOM3",5,0)
 ;
"RTN","SAMIHOM3",6,0)
 ; Routine SAMIHOM3 contains subroutines for implementing the ELCAP Home
"RTN","SAMIHOM3",7,0)
 ; Page. SAMIHOM3 is further enhanced to provide binding to VistA
"RTN","SAMIHOM3",8,0)
 ; CURRENTLY UNTESTED & IN PROGRESS
"RTN","SAMIHOM3",9,0)
 ;
"RTN","SAMIHOM3",10,0)
 quit  ; no entry from top
"RTN","SAMIHOM3",11,0)
 ;
"RTN","SAMIHOM3",12,0)
 ;
"RTN","SAMIHOM3",13,0)
 ;
"RTN","SAMIHOM3",14,0)
 ;@section 0 primary development
"RTN","SAMIHOM3",15,0)
 ;
"RTN","SAMIHOM3",16,0)
 ;
"RTN","SAMIHOM3",17,0)
 ;
"RTN","SAMIHOM3",18,0)
 ;@routine-credits
"RTN","SAMIHOM3",19,0)
 ;@primary-dev: George P. Lilly (gpl)
"RTN","SAMIHOM3",20,0)
 ; gpl@vistaexpertise.net
"RTN","SAMIHOM3",21,0)
 ;@primary-dev-org: Vista Expertise Network (ven)
"RTN","SAMIHOM3",22,0)
 ; http://vistaexpertise.net
"RTN","SAMIHOM3",23,0)
 ;@copyright: 2017, gpl, all rights reserved
"RTN","SAMIHOM3",24,0)
 ;@license: Apache 2.0
"RTN","SAMIHOM3",25,0)
 ; https://www.apache.org/licenses/LICENSE-2.0.html
"RTN","SAMIHOM3",26,0)
 ;
"RTN","SAMIHOM3",27,0)
 ;@last-updated: 2018-03-07T18:48Z
"RTN","SAMIHOM3",28,0)
 ;@application: Screening Applications Management (SAM)
"RTN","SAMIHOM3",29,0)
 ;@module: Screening Applications Management - IELCAP (SAMI)
"RTN","SAMIHOM3",30,0)
 ;@suite-of-files: SAMI Forms (311.101-311.199)
"RTN","SAMIHOM3",31,0)
 ;@version: 18.0T04
"RTN","SAMIHOM3",32,0)
 ;@release-date: not yet released
"RTN","SAMIHOM3",33,0)
 ;@patch-list: none yet
"RTN","SAMIHOM3",34,0)
 ;
"RTN","SAMIHOM3",35,0)
 ;@additional-dev: Frederick D. S. Marshall (toad)
"RTN","SAMIHOM3",36,0)
 ; toad@vistaexpertise.net
"RTN","SAMIHOM3",37,0)
 ;
"RTN","SAMIHOM3",38,0)
 ;@module-credits
"RTN","SAMIHOM3",39,0)
 ;@project: VA Partnership to Increase Access to Lung Screening
"RTN","SAMIHOM3",40,0)
 ; (VA-PALS)
"RTN","SAMIHOM3",41,0)
 ; http://va-pals.org/
"RTN","SAMIHOM3",42,0)
 ;@funding: 2017/2018, Bristol-Myers Squibb Foundation (bmsf)
"RTN","SAMIHOM3",43,0)
 ; https://www.bms.com/about-us/responsibility/bristol-myers-squibb-foundation.html
"RTN","SAMIHOM3",44,0)
 ;@partner-org: Veterans Affairs Office of Rural health
"RTN","SAMIHOM3",45,0)
 ; https://www.ruralhealth.va.gov/
"RTN","SAMIHOM3",46,0)
 ;@partner-org: International Early Lung Cancer Action Program (I-ELCAP)
"RTN","SAMIHOM3",47,0)
 ; http://ielcap.com/
"RTN","SAMIHOM3",48,0)
 ;@partner-org: Paraxial Technologies
"RTN","SAMIHOM3",49,0)
 ; http://paraxialtech.com/
"RTN","SAMIHOM3",50,0)
 ;@partner-org: Open Source Electronic Health Record Alliance (OSEHRA)
"RTN","SAMIHOM3",51,0)
 ; https://www.osehra.org/groups/va-pals-open-source-project-group
"RTN","SAMIHOM3",52,0)
 ;
"RTN","SAMIHOM3",53,0)
 ;@module-log
"RTN","SAMIHOM3",54,0)
 ; 2018-01-13 ven/gpl v18.0t04 SAMIHOM3: create routine from SAMIFRM to
"RTN","SAMIHOM3",55,0)
 ; implement ELCAP Home Page.
"RTN","SAMIHOM3",56,0)
 ;
"RTN","SAMIHOM3",57,0)
 ; 2018-02-05 ven/toad v18.0t04 SAMIHOM3: update license & attribution &
"RTN","SAMIHOM3",58,0)
 ; hdr comments, add white space & do-dot quits, spell out language
"RTN","SAMIHOM3",59,0)
 ; elements.
"RTN","SAMIHOM3",60,0)
 ;
"RTN","SAMIHOM3",61,0)
 ; 2018-02-27 ven/gpl v18.0t04 SAMIHOM3: new subroutines $$PREFIX,GETHOME,
"RTN","SAMIHOM3",62,0)
 ; $$SCANFOR,WSNEWCAS,PREFILL,MKSBFORM,MKSIFORM,$$VALDTNM,
"RTN","SAMIHOM3",63,0)
 ; $$SID2NUM,$$KEYDATE,$$GENSTDID,$$NEXTNUM to support creation of new
"RTN","SAMIHOM3",64,0)
 ; cases.
"RTN","SAMIHOM3",65,0)
 ;
"RTN","SAMIHOM3",66,0)
 ; 2018-03-01 ven/toad v18.0t04 SAMIHOM3: refactor & reorganize new code,
"RTN","SAMIHOM3",67,0)
 ; add header comments, r/findReplaceAll^%wf w/findReplace^%ts.
"RTN","SAMIHOM3",68,0)
 ;
"RTN","SAMIHOM3",69,0)
 ; 2018-03-06 ven/gpl v18.0t04 SAMIHOM3: ?
"RTN","SAMIHOM3",70,0)
 ;
"RTN","SAMIHOM3",71,0)
 ; 2018-03-07 ven/toad v18.0t04 SAMIHOM3: in $$SID2NUM add
"RTN","SAMIHOM3",72,0)
 ; WSNUFORM^SAMICASE to called-by list; in keyDate,GETHOME update
"RTN","SAMIHOM3",73,0)
 ; called-by.
"RTN","SAMIHOM3",74,0)
 ;
"RTN","SAMIHOM3",75,0)
 ;@contents
"RTN","SAMIHOM3",76,0)
 ;
"RTN","SAMIHOM3",77,0)
 ;  code for SAMI homepage web service
"RTN","SAMIHOM3",78,0)
 ;
"RTN","SAMIHOM3",79,0)
 ; WSHOME: web service for SAMI homepage
"RTN","SAMIHOM3",80,0)
 ; DEVHOME: temporary home page for development
"RTN","SAMIHOM3",81,0)
 ; PATLIST: returns a list of patients in ary, passed by name
"RTN","SAMIHOM3",82,0)
 ; GETHOME: homepage accessed using GET (not subsequent visit)
"RTN","SAMIHOM3",83,0)
 ; $$SCANFOR = scan array looking for value, return index
"RTN","SAMIHOM3",84,0)
 ;
"RTN","SAMIHOM3",85,0)
 ;  code for SAMI new case web service
"RTN","SAMIHOM3",86,0)
 ;
"RTN","SAMIHOM3",87,0)
 ; WSNEWCAS: web service receives post from home & creates new case
"RTN","SAMIHOM3",88,0)
 ; $$NEXTNUM = next number for studyid
"RTN","SAMIHOM3",89,0)
 ; $$GENSTDID = studyID for number
"RTN","SAMIHOM3",90,0)
 ; $$PREFIX = letters to use to begin studyId
"RTN","SAMIHOM3",91,0)
 ; $$KEYDATE = date in StudyId format (yyyy-mm-dd)
"RTN","SAMIHOM3",92,0)
 ; $$VALDTNM = validate a new name
"RTN","SAMIHOM3",93,0)
 ; PREFILL: prefill fields for forms
"RTN","SAMIHOM3",94,0)
 ; MKSIFORM: create intake form
"RTN","SAMIHOM3",95,0)
 ; MKSBFORM: create background form
"RTN","SAMIHOM3",96,0)
 ;
"RTN","SAMIHOM3",97,0)
 ;  api $$SID2NUM^SAMIHOM3
"RTN","SAMIHOM3",98,0)
 ;
"RTN","SAMIHOM3",99,0)
 ; $$SID2NUM = number part of studyid (XXX0001 -> 1)
"RTN","SAMIHOM3",100,0)
 ;
"RTN","SAMIHOM3",101,0)
 ;
"RTN","SAMIHOM3",102,0)
 ;
"RTN","SAMIHOM3",103,0)
 ;@section 1 code for SAMI homepage web service
"RTN","SAMIHOM3",104,0)
 ;
"RTN","SAMIHOM3",105,0)
 ;
"RTN","SAMIHOM3",106,0)
 ;
"RTN","SAMIHOM3",107,0)
 ; web service for SAMI homepage
"RTN","SAMIHOM3",108,0)
WSHOME(SAMIRTN,SAMIFILTER) goto WSHOME^SAMIHOM4
"RTN","SAMIHOM3",109,0)
 ;
"RTN","SAMIHOM3",110,0)
 ;
"RTN","SAMIHOM3",111,0)
 ; vapals post web service - all calls come through this gateway
"RTN","SAMIHOM3",112,0)
WSVAPALS(SAMIARG,SAMIBODY,SAMIRESULT) goto WSVAPALS^SAMIHOM4
"RTN","SAMIHOM3",113,0)
 ;
"RTN","SAMIHOM3",114,0)
 ;
"RTN","SAMIHOM3",115,0)
DEVHOME(SAMIRTN,SAMIFILTER) goto DEVHOME^SAMIHOM4
"RTN","SAMIHOM3",116,0)
 ;
"RTN","SAMIHOM3",117,0)
 ;
"RTN","SAMIHOM3",118,0)
PATLIST(ARY) ; returns a list of patients in ary, passed by name
"RTN","SAMIHOM3",119,0)
 ;
"RTN","SAMIHOM3",120,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMIHOM3",121,0)
 ;
"RTN","SAMIHOM3",122,0)
 ;ven/gpl;private;procedure;
"RTN","SAMIHOM3",123,0)
 ;@called-by
"RTN","SAMIHOM3",124,0)
 ; DEVHOME
"RTN","SAMIHOM3",125,0)
 ;@calls
"RTN","SAMIHOM3",126,0)
 ; $$setroot^%wd
"RTN","SAMIHOM3",127,0)
 ;@input
"RTN","SAMIHOM3",128,0)
 ; ary = name of array to return patient list in
"RTN","SAMIHOM3",129,0)
 ;@output
"RTN","SAMIHOM3",130,0)
 ; @ary = array containing list of patients
"RTN","SAMIHOM3",131,0)
 ;@examples [tbd]
"RTN","SAMIHOM3",132,0)
 ;@tests [tbd]
"RTN","SAMIHOM3",133,0)
 ;
"RTN","SAMIHOM3",134,0)
 ;@stanza 2 build list of patients
"RTN","SAMIHOM3",135,0)
 ;
"RTN","SAMIHOM3",136,0)
 new GROOT set GROOT=$$setroot^%wd("vapals-patients")
"RTN","SAMIHOM3",137,0)
 ;
"RTN","SAMIHOM3",138,0)
 kill @ARY
"RTN","SAMIHOM3",139,0)
 new zi set zi=""
"RTN","SAMIHOM3",140,0)
 for  set zi=$order(@GROOT@("graph",zi)) quit:zi=""  do  ;
"RTN","SAMIHOM3",141,0)
 . set @ARY@(zi)=""
"RTN","SAMIHOM3",142,0)
 . quit
"RTN","SAMIHOM3",143,0)
 ;
"RTN","SAMIHOM3",144,0)
 ;@stanza 3 termination
"RTN","SAMIHOM3",145,0)
 ;
"RTN","SAMIHOM3",146,0)
 quit  ; end of PATLIST
"RTN","SAMIHOM3",147,0)
 ;
"RTN","SAMIHOM3",148,0)
 ;
"RTN","SAMIHOM3",149,0)
 ;
"RTN","SAMIHOM3",150,0)
 ; homepage accessed using GET
"RTN","SAMIHOM3",151,0)
GETHOME(SAMIRTN,SAMIFILTER) goto GETHOME^SAMIHOM4
"RTN","SAMIHOM3",152,0)
 ;
"RTN","SAMIHOM3",153,0)
 ;
"RTN","SAMIHOM3",154,0)
SCANFOR(ary,start,what) ; scan array looking for value
"RTN","SAMIHOM3",155,0)
 ;
"RTN","SAMIHOM3",156,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMIHOM3",157,0)
 ;
"RTN","SAMIHOM3",158,0)
 ;ven/gpl;private;function;
"RTN","SAMIHOM3",159,0)
 ;@called-by
"RTN","SAMIHOM3",160,0)
 ; GETHOME
"RTN","SAMIHOM3",161,0)
 ;@calls: none
"RTN","SAMIHOM3",162,0)
 ;@input
"RTN","SAMIHOM3",163,0)
 ;.ary = array to scan
"RTN","SAMIHOM3",164,0)
 ; start = index to begin scanning at
"RTN","SAMIHOM3",165,0)
 ; what = value to scan array for
"RTN","SAMIHOM3",166,0)
 ;@output = array index where value was found
"RTN","SAMIHOM3",167,0)
 ;@examples [tbd]
"RTN","SAMIHOM3",168,0)
 ;@tests [tbd]
"RTN","SAMIHOM3",169,0)
 ;
"RTN","SAMIHOM3",170,0)
 ;@stanza 2 scan array
"RTN","SAMIHOM3",171,0)
 ;
"RTN","SAMIHOM3",172,0)
 ;  returns the index in the array where what occurs
"RTN","SAMIHOM3",173,0)
 ;  ary is passed by reference
"RTN","SAMIHOM3",174,0)
 ;
"RTN","SAMIHOM3",175,0)
 new limit s limit=0
"RTN","SAMIHOM3",176,0)
 new %1 set %1=start
"RTN","SAMIHOM3",177,0)
 for  set %1=$order(ary(%1)) quit:+%1=0  quit:limit>1000  quit:ary(%1)[what  do  ;
"RTN","SAMIHOM3",178,0)
 . set limit=limit+1
"RTN","SAMIHOM3",179,0)
 . ;W !,ary(%1)
"RTN","SAMIHOM3",180,0)
 . quit
"RTN","SAMIHOM3",181,0)
 ;
"RTN","SAMIHOM3",182,0)
 ;@stanza 3 return & termination
"RTN","SAMIHOM3",183,0)
 n zrtn
"RTN","SAMIHOM3",184,0)
 s zrtn=%1
"RTN","SAMIHOM3",185,0)
 i %1<start s zrtn=start
"RTN","SAMIHOM3",186,0)
 i %1>1000 s zrtn=start
"RTN","SAMIHOM3",187,0)
 ;
"RTN","SAMIHOM3",188,0)
 quit zrtn ; return array index; end of $$$SCANFOR
"RTN","SAMIHOM3",189,0)
 ;
"RTN","SAMIHOM3",190,0)
 ;
"RTN","SAMIHOM3",191,0)
 ;
"RTN","SAMIHOM3",192,0)
 ;@section 2 code for SAMI new case web service
"RTN","SAMIHOM3",193,0)
 ;
"RTN","SAMIHOM3",194,0)
 ;
"RTN","SAMIHOM3",195,0)
 ;
"RTN","SAMIHOM3",196,0)
 ; receives post from home & creates new case
"RTN","SAMIHOM3",197,0)
WSNEWCAS(SAMIARGS,SAMIBODY,SAMIRESULT) goto WSNEWCAS^SAMIHOM4
"RTN","SAMIHOM3",198,0)
 ;
"RTN","SAMIHOM3",199,0)
 ;
"RTN","SAMIHOM3",200,0)
NEXTNUM() ; next number for studyid
"RTN","SAMIHOM3",201,0)
 ;
"RTN","SAMIHOM3",202,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMIHOM3",203,0)
 ;
"RTN","SAMIHOM3",204,0)
 ;ven/gpl;private;variable;
"RTN","SAMIHOM3",205,0)
 ;@called-by
"RTN","SAMIHOM3",206,0)
 ; WSNEWCAS
"RTN","SAMIHOM3",207,0)
 ;@calls
"RTN","SAMIHOM3",208,0)
 ; $$setroot^%wd
"RTN","SAMIHOM3",209,0)
 ;@input: none
"RTN","SAMIHOM3",210,0)
 ;@output = next number for study id
"RTN","SAMIHOM3",211,0)
 ;@examples [tbd]
"RTN","SAMIHOM3",212,0)
 ;@tests [tbd]
"RTN","SAMIHOM3",213,0)
 ;
"RTN","SAMIHOM3",214,0)
 ;@stanza 2 calculate next number
"RTN","SAMIHOM3",215,0)
 ;
"RTN","SAMIHOM3",216,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMIHOM3",217,0)
 new number set number=$order(@root@("  "),-1)+1
"RTN","SAMIHOM3",218,0)
 ;
"RTN","SAMIHOM3",219,0)
 ;@stanza 3 return & termination
"RTN","SAMIHOM3",220,0)
 ;
"RTN","SAMIHOM3",221,0)
 quit number ; return #; end of $$NEXTNUM
"RTN","SAMIHOM3",222,0)
 ;
"RTN","SAMIHOM3",223,0)
 ;
"RTN","SAMIHOM3",224,0)
 ;
"RTN","SAMIHOM3",225,0)
GENSTDID(num,ARG) ; studyID for number
"RTN","SAMIHOM3",226,0)
 ;
"RTN","SAMIHOM3",227,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMIHOM3",228,0)
 ;
"RTN","SAMIHOM3",229,0)
 ;ven/gpl;private;function;
"RTN","SAMIHOM3",230,0)
 ;@called-by
"RTN","SAMIHOM3",231,0)
 ; WSNEWCAS
"RTN","SAMIHOM3",232,0)
 ; wsLookup^SAMISRCH
"RTN","SAMIHOM3",233,0)
 ;@calls
"RTN","SAMIHOM3",234,0)
 ; $$PREFIX
"RTN","SAMIHOM3",235,0)
 ;@input
"RTN","SAMIHOM3",236,0)
 ; num = number of study id
"RTN","SAMIHOM3",237,0)
 ;@output = study id corresponding to number
"RTN","SAMIHOM3",238,0)
 ;@examples [tbd]
"RTN","SAMIHOM3",239,0)
 ;@tests [tbd]
"RTN","SAMIHOM3",240,0)
 ;
"RTN","SAMIHOM3",241,0)
 ;@stanza 2 calculate study id
"RTN","SAMIHOM3",242,0)
 ;
"RTN","SAMIHOM3",243,0)
 new zl set zl=$length(num)
"RTN","SAMIHOM3",244,0)
 new zz set zz="00000"
"RTN","SAMIHOM3",245,0)
 ;new studyid set studyid=$$GETPRFX^SAMIFORM(.ARG)_$extract(zz,1,5-zl)_num
"RTN","SAMIHOM3",246,0)
 ; the prefix is determined by the site or siteid, which should be passed
"RTN","SAMIHOM3",247,0)
 ; in ARG
"RTN","SAMIHOM3",248,0)
 n tsite s tsite=$g(ARG("siteid"))
"RTN","SAMIHOM3",249,0)
 i tsite="" s tsite=$g(ARG("site"))
"RTN","SAMIHOM3",250,0)
 i tsite="" s tsite="UNK"
"RTN","SAMIHOM3",251,0)
 new studyid set studyid=tsite_$extract(zz,1,5-zl)_num
"RTN","SAMIHOM3",252,0)
 ;
"RTN","SAMIHOM3",253,0)
 ;@stanza 3 return & termination
"RTN","SAMIHOM3",254,0)
 ;
"RTN","SAMIHOM3",255,0)
 quit studyid ; return study id; end of $$GENSTDID
"RTN","SAMIHOM3",256,0)
 ;
"RTN","SAMIHOM3",257,0)
 ;
"RTN","SAMIHOM3",258,0)
 ;
"RTN","SAMIHOM3",259,0)
KEYDATE(fmdt) ; date in StudyId format (yyyy-mm-dd)
"RTN","SAMIHOM3",260,0)
 ;
"RTN","SAMIHOM3",261,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMIHOM3",262,0)
 ;
"RTN","SAMIHOM3",263,0)
 ;ven/gpl;private;function;
"RTN","SAMIHOM3",264,0)
 ;@called-by
"RTN","SAMIHOM3",265,0)
 ; WSNEWCAS
"RTN","SAMIHOM3",266,0)
 ; WSNFPOST^SAMICASE
"RTN","SAMIHOM3",267,0)
 ;@calls
"RTN","SAMIHOM3",268,0)
 ; $$FMTE^XLFDT
"RTN","SAMIHOM3",269,0)
 ;@input
"RTN","SAMIHOM3",270,0)
 ; fmdt = date in fileman format
"RTN","SAMIHOM3",271,0)
 ;@output = date in study id format
"RTN","SAMIHOM3",272,0)
 ;@examples [tbd]
"RTN","SAMIHOM3",273,0)
 ;@tests [tbd]
"RTN","SAMIHOM3",274,0)
 ;
"RTN","SAMIHOM3",275,0)
 ;@stanza 2 calculate studyid format
"RTN","SAMIHOM3",276,0)
 ;
"RTN","SAMIHOM3",277,0)
 new zdt set zdt=$$FMTE^XLFDT(fmdt,"7D")
"RTN","SAMIHOM3",278,0)
 ;
"RTN","SAMIHOM3",279,0)
 new zy,zm,zd
"RTN","SAMIHOM3",280,0)
 set zy=$piece(zdt,"/",1)
"RTN","SAMIHOM3",281,0)
 set zm=$piece(zdt,"/",2)
"RTN","SAMIHOM3",282,0)
 if $length(zm)=1 set zm="0"_zm
"RTN","SAMIHOM3",283,0)
 set zd=$piece(zdt,"/",3)
"RTN","SAMIHOM3",284,0)
 if $length(zd)=1 set zd="0"_zd
"RTN","SAMIHOM3",285,0)
 ;
"RTN","SAMIHOM3",286,0)
 new studydate set studydate=zy_"-"_zm_"-"_zd
"RTN","SAMIHOM3",287,0)
 ;
"RTN","SAMIHOM3",288,0)
 ;@stanza 3 return & termination
"RTN","SAMIHOM3",289,0)
 ;
"RTN","SAMIHOM3",290,0)
 quit studydate ; return date; end of $$KEYDATE
"RTN","SAMIHOM3",291,0)
 ;
"RTN","SAMIHOM3",292,0)
 ;
"RTN","SAMIHOM3",293,0)
 ;
"RTN","SAMIHOM3",294,0)
VALDTNM(nm,args) ; validate new name
"RTN","SAMIHOM3",295,0)
 ;
"RTN","SAMIHOM3",296,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMIHOM3",297,0)
 ;
"RTN","SAMIHOM3",298,0)
 ;ven/gpl;private;function;
"RTN","SAMIHOM3",299,0)
 ;@called-by
"RTN","SAMIHOM3",300,0)
 ; WSNEWCAS
"RTN","SAMIHOM3",301,0)
 ;@calls: none
"RTN","SAMIHOM3",302,0)
 ;@input
"RTN","SAMIHOM3",303,0)
 ; nm = name to validate
"RTN","SAMIHOM3",304,0)
 ;.args = array to return error messages
"RTN","SAMIHOM3",305,0)
 ;@output = 1 if valid, -1 if not
"RTN","SAMIHOM3",306,0)
 ;@examples [tbd]
"RTN","SAMIHOM3",307,0)
 ;@tests [tbd]
"RTN","SAMIHOM3",308,0)
 ;
"RTN","SAMIHOM3",309,0)
 ;@stanza 2 screen for invalid name
"RTN","SAMIHOM3",310,0)
 ;
"RTN","SAMIHOM3",311,0)
 if nm'["," do  quit -1 ;
"RTN","SAMIHOM3",312,0)
 . set args("saminuerror")="invalid name"
"RTN","SAMIHOM3",313,0)
 . quit
"RTN","SAMIHOM3",314,0)
 ;
"RTN","SAMIHOM3",315,0)
 ;@stanza 3 return & termination
"RTN","SAMIHOM3",316,0)
 ;
"RTN","SAMIHOM3",317,0)
 quit 1 ; return success; end of $$VALDTNM
"RTN","SAMIHOM3",318,0)
 ;
"RTN","SAMIHOM3",319,0)
 ;
"RTN","SAMIHOM3",320,0)
 ;
"RTN","SAMIHOM3",321,0)
PREFILL(dfn) ; prefill fields for form
"RTN","SAMIHOM3",322,0)
 ;
"RTN","SAMIHOM3",323,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMIHOM3",324,0)
 ;
"RTN","SAMIHOM3",325,0)
 ;ven/gpl;private;procedure;
"RTN","SAMIHOM3",326,0)
 ;@called-by
"RTN","SAMIHOM3",327,0)
 ; WSNEWCAS
"RTN","SAMIHOM3",328,0)
 ;@calls
"RTN","SAMIHOM3",329,0)
 ; $$setroot^%wd
"RTN","SAMIHOM3",330,0)
 ;@input
"RTN","SAMIHOM3",331,0)
 ; gien =
"RTN","SAMIHOM3",332,0)
 ;@output
"RTN","SAMIHOM3",333,0)
 ; @root(gien) = ...
"RTN","SAMIHOM3",334,0)
 ;  where root = graph root for elcap patients
"RTN","SAMIHOM3",335,0)
 ;@examples [tbd]
"RTN","SAMIHOM3",336,0)
 ;@tests [tbd]
"RTN","SAMIHOM3",337,0)
 ;
"RTN","SAMIHOM3",338,0)
 ;@stanza 2 prefill fields
"RTN","SAMIHOM3",339,0)
 ;
"RTN","SAMIHOM3",340,0)
 ; pull data from VistA
"RTN","SAMIHOM3",341,0)
 ;
"RTN","SAMIHOM3",342,0)
 ;n ok
"RTN","SAMIHOM3",343,0)
 ;s ok=$$PTINFO^SAMIVSTA(dfn)
"RTN","SAMIHOM3",344,0)
 ;i +ok<1 D ^ZTER
"RTN","SAMIHOM3",345,0)
 d PTINFO^SAMIVSTA(dfn)
"RTN","SAMIHOM3",346,0)
 ;
"RTN","SAMIHOM3",347,0)
 ; prefills fields from patient-lookup graph
"RTN","SAMIHOM3",348,0)
 ;
"RTN","SAMIHOM3",349,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMIHOM3",350,0)
 new lroot s lroot=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM3",351,0)
 new lien s lien=$o(@lroot@("dfn",dfn,""))
"RTN","SAMIHOM3",352,0)
 q:lien=""
"RTN","SAMIHOM3",353,0)
 n gien s gien=$o(@root@("dfn",dfn,"")) ; 
"RTN","SAMIHOM3",354,0)
 q:gien=""
"RTN","SAMIHOM3",355,0)
 ; merge prefill fields
"RTN","SAMIHOM3",356,0)
 m @root@(gien)=@lroot@(lien)
"RTN","SAMIHOM3",357,0)
 ; fix format problems
"RTN","SAMIHOM3",358,0)
 new saminame set saminame=$get(@root@(gien,"saminame"))
"RTN","SAMIHOM3",359,0)
 ; dob format
"RTN","SAMIHOM3",360,0)
 n dob s dob=$g(@lroot@(lien,"sbdob"))
"RTN","SAMIHOM3",361,0)
 n X,Y
"RTN","SAMIHOM3",362,0)
 S X=dob
"RTN","SAMIHOM3",363,0)
 d ^%DT
"RTN","SAMIHOM3",364,0)
 Q:Y=-1
"RTN","SAMIHOM3",365,0)
 s dob=Y
"RTN","SAMIHOM3",366,0)
 if dob'="" set @root@(gien,"sbdob")=$$VAPALSDT^SAMICASE(dob)
"RTN","SAMIHOM3",367,0)
 if dob'="" set @root@(gien,"sidob")=$$VAPALSDT^SAMICASE(dob)
"RTN","SAMIHOM3",368,0)
 ; ssn format
"RTN","SAMIHOM3",369,0)
 n ssn s ssn=$g(@lroot@(lien,"ssn"))
"RTN","SAMIHOM3",370,0)
 if $l(ssn)=9 set @root@(gien,"sissn")=$e(ssn,1,3)_"-"_$e(ssn,4,5)_"-"_$e(ssn,6,9)
"RTN","SAMIHOM3",371,0)
 ; studyid
"RTN","SAMIHOM3",372,0)
 set @root@(gien,"sisid")=@root@(gien,"samistudyid")
"RTN","SAMIHOM3",373,0)
 ;
"RTN","SAMIHOM3",374,0)
 ;@stanza 3 termination
"RTN","SAMIHOM3",375,0)
 ;
"RTN","SAMIHOM3",376,0)
 quit  ; end of PREFILL
"RTN","SAMIHOM3",377,0)
 ;
"RTN","SAMIHOM3",378,0)
 ;
"RTN","SAMIHOM3",379,0)
 ;
"RTN","SAMIHOM3",380,0)
MKSBFORM(num) ; create background form -- depricated gpl 20180615
"RTN","SAMIHOM3",381,0)
 ;
"RTN","SAMIHOM3",382,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMIHOM3",383,0)
 ;
"RTN","SAMIHOM3",384,0)
 ;ven/gpl;private;procedure;
"RTN","SAMIHOM3",385,0)
 ;@called-by
"RTN","SAMIHOM3",386,0)
 ; WSNEWCAS
"RTN","SAMIHOM3",387,0)
 ;@calls
"RTN","SAMIHOM3",388,0)
 ; $$setroot^%wd
"RTN","SAMIHOM3",389,0)
 ;@input
"RTN","SAMIHOM3",390,0)
 ; num = index where new form should be built
"RTN","SAMIHOM3",391,0)
 ;@output
"RTN","SAMIHOM3",392,0)
 ; @root(num) = ...
"RTN","SAMIHOM3",393,0)
 ;  where root = graph root for elcap patients
"RTN","SAMIHOM3",394,0)
 ; @root@("graph")
"RTN","SAMIHOM3",395,0)
 ;@examples [tbd]
"RTN","SAMIHOM3",396,0)
 ;@tests [tbd]
"RTN","SAMIHOM3",397,0)
 ;
"RTN","SAMIHOM3",398,0)
 ;@stanza 2 build background form & place graph
"RTN","SAMIHOM3",399,0)
 ;
"RTN","SAMIHOM3",400,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMIHOM3",401,0)
 new sid set sid=$get(@root@(num,"samistudyid"))
"RTN","SAMIHOM3",402,0)
 quit:sid=""
"RTN","SAMIHOM3",403,0)
 new cdate set cdate=$get(@root@(num,"samicreatedate"))
"RTN","SAMIHOM3",404,0)
 quit:cdate=""
"RTN","SAMIHOM3",405,0)
 merge @root@("graph",sid,"sbform-"_cdate)=@root@(num)
"RTN","SAMIHOM3",406,0)
 d SSAMISTA^SAMICASE(sid,"sbform-"_cdate,"incomplete")
"RTN","SAMIHOM3",407,0)
 ;
"RTN","SAMIHOM3",408,0)
 ;@stanza 3 termination
"RTN","SAMIHOM3",409,0)
 ;
"RTN","SAMIHOM3",410,0)
 quit  ; end of MKSBFORM
"RTN","SAMIHOM3",411,0)
 ;
"RTN","SAMIHOM3",412,0)
 ;
"RTN","SAMIHOM3",413,0)
 ;
"RTN","SAMIHOM3",414,0)
MKSIFORM(num) ; create intake form
"RTN","SAMIHOM3",415,0)
 ;
"RTN","SAMIHOM3",416,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMIHOM3",417,0)
 ;
"RTN","SAMIHOM3",418,0)
 ;ven/gpl;private;procedure;
"RTN","SAMIHOM3",419,0)
 ;@called-by
"RTN","SAMIHOM3",420,0)
 ; WSNEWCAS
"RTN","SAMIHOM3",421,0)
 ;@calls
"RTN","SAMIHOM3",422,0)
 ; $$setroot^%wd
"RTN","SAMIHOM3",423,0)
 ;@input
"RTN","SAMIHOM3",424,0)
 ; num = index where new form should be built
"RTN","SAMIHOM3",425,0)
 ;@output
"RTN","SAMIHOM3",426,0)
 ; @root(num) = ...
"RTN","SAMIHOM3",427,0)
 ;  where root = graph root for elcap patients
"RTN","SAMIHOM3",428,0)
 ; @root@("graph")
"RTN","SAMIHOM3",429,0)
 ;@examples [tbd]
"RTN","SAMIHOM3",430,0)
 ;@tests [tbd]
"RTN","SAMIHOM3",431,0)
 ;
"RTN","SAMIHOM3",432,0)
 ;@stanza 2 build intake form & place graph
"RTN","SAMIHOM3",433,0)
 ;
"RTN","SAMIHOM3",434,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMIHOM3",435,0)
 new sid set sid=$get(@root@(num,"samistudyid"))
"RTN","SAMIHOM3",436,0)
 quit:sid=""
"RTN","SAMIHOM3",437,0)
 new cdate set cdate=$get(@root@(num,"samicreatedate"))
"RTN","SAMIHOM3",438,0)
 quit:cdate=""
"RTN","SAMIHOM3",439,0)
 merge @root@("graph",sid,"siform-"_cdate)=@root@(num)
"RTN","SAMIHOM3",440,0)
 d SSAMISTA^SAMICASE(sid,"siform-"_cdate,"complete")
"RTN","SAMIHOM3",441,0)
 ; initialize form from VistA data
"RTN","SAMIHOM3",442,0)
 n zf s zf=$na(@root@("graph",sid,"siform-"_cdate))
"RTN","SAMIHOM3",443,0)
 s @zf@("sipsa")=$g(@root@(num,"address1")) ; primary address
"RTN","SAMIHOM3",444,0)
 s @zf@("sipan")=$g(@root@(num,"address2")) ; apartment number
"RTN","SAMIHOM3",445,0)
 s @zf@("sipc")=$g(@root@(num,"city")) ; city
"RTN","SAMIHOM3",446,0)
 s @zf@("sips")=$g(@root@(num,"state")) ; state
"RTN","SAMIHOM3",447,0)
 s @zf@("sipcn")=$g(@root@(num,"county")) ; county
"RTN","SAMIHOM3",448,0)
 s @zf@("sipcr")="USA" ; country
"RTN","SAMIHOM3",449,0)
 s @zf@("sipz")=$g(@root@(num,"zip")) ; zip
"RTN","SAMIHOM3",450,0)
 i @zf@("sipz")'="" d  ;
"RTN","SAMIHOM3",451,0)
 . n zip s zip=@zf@("sipz")
"RTN","SAMIHOM3",452,0)
 . q:zip=""
"RTN","SAMIHOM3",453,0)
 . n ru s ru=$$URBRUR^SAMIVSTA(zip)
"RTN","SAMIHOM3",454,0)
 . i ru=0 s ru="n"
"RTN","SAMIHOM3",455,0)
 . i (ru="r")!(ru="u")!(ru="n") s @zf@("sirs")=ru
"RTN","SAMIHOM3",456,0)
 . s @root@(num,"sirs")=$g(@zf@("sirs"))
"RTN","SAMIHOM3",457,0)
 n phn s phn=$g(@root@(num,"phone")) ; phone number
"RTN","SAMIHOM3",458,0)
 i phn["x" s phn=$p(phn," x",1)
"RTN","SAMIHOM3",459,0)
 s @zf@("sippn")=phn
"RTN","SAMIHOM3",460,0)
 s @zf@("sidc")=$$VAPALSDT^SAMICASE($$NOW^XLFDT)
"RTN","SAMIHOM3",461,0)
 s @zf@("sipedc")=$$VAPALSDT^SAMICASE($$NOW^XLFDT)
"RTN","SAMIHOM3",462,0)
 ; set samifirsttime variable for intake form
"RTN","SAMIHOM3",463,0)
 s @zf@("samifirsttime")="true"
"RTN","SAMIHOM3",464,0)
 ;
"RTN","SAMIHOM3",465,0)
 ;@stanza 3 termination
"RTN","SAMIHOM3",466,0)
 ;
"RTN","SAMIHOM3",467,0)
 quit "siform-"_cdate ; end of MKSIFORM
"RTN","SAMIHOM3",468,0)
 ;
"RTN","SAMIHOM3",469,0)
 ;
"RTN","SAMIHOM3",470,0)
 ;
"RTN","SAMIHOM3",471,0)
 ;@section 4 api $$SID2NUM^SAMIHOM3
"RTN","SAMIHOM3",472,0)
 ;
"RTN","SAMIHOM3",473,0)
 ;
"RTN","SAMIHOM3",474,0)
 ;
"RTN","SAMIHOM3",475,0)
 ;@API $$SID2NUM^SAMIHOM3, number part of study id
"RTN","SAMIHOM3",476,0)
SID2NUM(sid) ; number part of studyid (XXX0001 -> 1)
"RTN","SAMIHOM3",477,0)
 ;
"RTN","SAMIHOM3",478,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMIHOM3",479,0)
 ;
"RTN","SAMIHOM3",480,0)
 ;ven/gpl;public;function;
"RTN","SAMIHOM3",481,0)
 ;@called-by
"RTN","SAMIHOM3",482,0)
 ; getVals^%wfhform
"RTN","SAMIHOM3",483,0)
 ; WSCASE^SAMICASE
"RTN","SAMIHOM3",484,0)
 ; WSNUFORM^SAMICASE
"RTN","SAMIHOM3",485,0)
 ; MKCEFORM^SAMICASE
"RTN","SAMIHOM3",486,0)
 ;@calls: none
"RTN","SAMIHOM3",487,0)
 ;@input
"RTN","SAMIHOM3",488,0)
 ; sid = study id
"RTN","SAMIHOM3",489,0)
 ;@output = number from study id
"RTN","SAMIHOM3",490,0)
 ;@examples [tbd]
"RTN","SAMIHOM3",491,0)
 ;@tests [tbd]
"RTN","SAMIHOM3",492,0)
 ;
"RTN","SAMIHOM3",493,0)
 ;@stanza 2 calculate number
"RTN","SAMIHOM3",494,0)
 ;
"RTN","SAMIHOM3",495,0)
 new number set number=+$extract(sid,4,$length(sid))
"RTN","SAMIHOM3",496,0)
 ;
"RTN","SAMIHOM3",497,0)
 ;@stanza 3 return & termination
"RTN","SAMIHOM3",498,0)
 ;
"RTN","SAMIHOM3",499,0)
 quit number ; return number; end of $$sid2num
"RTN","SAMIHOM3",500,0)
 ;
"RTN","SAMIHOM3",501,0)
 ;
"RTN","SAMIHOM3",502,0)
ADDPAT(dfn) ; calls newCase to add patient dfn to vapals
"RTN","SAMIHOM3",503,0)
 n lroot s lroot=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM3",504,0)
 n lien s lien=$o(@lroot@("dfn",dfn,""))
"RTN","SAMIHOM3",505,0)
 q:lien=""
"RTN","SAMIHOM3",506,0)
 n name s name=$g(@lroot@(lien,"saminame"))
"RTN","SAMIHOM3",507,0)
 q:name=""
"RTN","SAMIHOM3",508,0)
 n bdy s bdy(1)="saminame="_name_"&dfn="_dfn
"RTN","SAMIHOM3",509,0)
 n ARGS,result
"RTN","SAMIHOM3",510,0)
 d WSNEWCAS(.ARGS,.bdy,.result)
"RTN","SAMIHOM3",511,0)
 ; zwr result
"RTN","SAMIHOM3",512,0)
 ;
"RTN","SAMIHOM3",513,0)
INDEX ; reindex the vapals-patients graph
"RTN","SAMIHOM3",514,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIHOM3",515,0)
 n zi s zi=0
"RTN","SAMIHOM3",516,0)
 f  s zi=$o(@root@(zi)) q:+zi=0  d  ;
"RTN","SAMIHOM3",517,0)
 . n dfn,sid
"RTN","SAMIHOM3",518,0)
 . s dfn=@root@(zi,"dfn")
"RTN","SAMIHOM3",519,0)
 . s sid=@root@(zi,"samistudyid")
"RTN","SAMIHOM3",520,0)
 . s @root@("dfn",dfn,zi)=""
"RTN","SAMIHOM3",521,0)
 . s @root@("sid",sid,zi)=""
"RTN","SAMIHOM3",522,0)
 q
"RTN","SAMIHOM3",523,0)
 ;
"RTN","SAMIHOM3",524,0)
EOR ; end of routine SAMIHOM3
"RTN","SAMIHOM4")
0^4^B565172253
"RTN","SAMIHOM4",1,0)
SAMIHOM4 ;ven/gpl,arc - ielcap: forms;2018-11-30T17:45Z ;Jan 14, 2020@16:04
"RTN","SAMIHOM4",2,0)
 ;;18.0;SAMI;;;Build 12
"RTN","SAMIHOM4",3,0)
 ;
"RTN","SAMIHOM4",4,0)
 ;@license: see routine SAMIUL
"RTN","SAMIHOM4",5,0)
 ;
"RTN","SAMIHOM4",6,0)
 ; @section 0 primary development
"RTN","SAMIHOM4",7,0)
 ;
"RTN","SAMIHOM4",8,0)
 ; @routine-credits
"RTN","SAMIHOM4",9,0)
 ; @primary-dev: George P. Lilly (gpl)
"RTN","SAMIHOM4",10,0)
 ;  gpl@vistaexpertise.net
"RTN","SAMIHOM4",11,0)
 ; @additional-dev: Alexis Carlson (arc)
"RTN","SAMIHOM4",12,0)
 ;  alexis@vistaexpertise.net
"RTN","SAMIHOM4",13,0)
 ; @primary-dev-org: Vista Expertise Network (ven)
"RTN","SAMIHOM4",14,0)
 ;  http://vistaexpertise.net
"RTN","SAMIHOM4",15,0)
 ; @copyright: 2012/2018, ven, all rights reserved
"RTN","SAMIHOM4",16,0)
 ; @license: Apache 2.0
"RTN","SAMIHOM4",17,0)
 ;  https://www.apache.org/licenses/LICENSE-2.0.html
"RTN","SAMIHOM4",18,0)
 ;
"RTN","SAMIHOM4",19,0)
 ; @application: SAMI
"RTN","SAMIHOM4",20,0)
 ; @version: 18.0
"RTN","SAMIHOM4",21,0)
 ; @patch-list: none yet
"RTN","SAMIHOM4",22,0)
 ;
"RTN","SAMIHOM4",23,0)
 ; @to-do
"RTN","SAMIHOM4",24,0)
 ;   Add label comments
"RTN","SAMIHOM4",25,0)
 ;
"RTN","SAMIHOM4",26,0)
 ; @section 1 code
"RTN","SAMIHOM4",27,0)
 ;
"RTN","SAMIHOM4",28,0)
 quit  ; No entry from top
"RTN","SAMIHOM4",29,0)
 ;
"RTN","SAMIHOM4",30,0)
 ;
"RTN","SAMIHOM4",31,0)
WSHOME ; web service for SAMI homepage
"RTN","SAMIHOM4",32,0)
 ; WSHOME^SAMIHOM3(SAMIRTN,SAMIFILTER) goto WSHOME^SAMIHOM4
"RTN","SAMIHOM4",33,0)
 ;
"RTN","SAMIHOM4",34,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMIHOM4",35,0)
 ;
"RTN","SAMIHOM4",36,0)
 ;ven/gpl;web service;procedure;
"RTN","SAMIHOM4",37,0)
 ;@called-by
"RTN","SAMIHOM4",38,0)
 ;@calls
"RTN","SAMIHOM4",39,0)
 ; GETHOME
"RTN","SAMIHOM4",40,0)
 ;@input
"RTN","SAMIHOM4",41,0)
 ; SAMIFILTER
"RTN","SAMIHOM4",42,0)
 ;@output
"RTN","SAMIHOM4",43,0)
 ;.SAMIRTN
"RTN","SAMIHOM4",44,0)
 ;@examples [tbd]
"RTN","SAMIHOM4",45,0)
 ;@tests [tbd]
"RTN","SAMIHOM4",46,0)
 ;
"RTN","SAMIHOM4",47,0)
 ; no parameters required
"RTN","SAMIHOM4",48,0)
 ;
"RTN","SAMIHOM4",49,0)
 ;@stanza 2 present development or temporary homepage
"RTN","SAMIHOM4",50,0)
 ;
"RTN","SAMIHOM4",51,0)
 if $get(SAMIFILTER("test"))=1 do  quit
"RTN","SAMIHOM4",52,0)
 . do DEVHOME^SAMIHOM3(.SAMIRTN,.SAMIFILTER)
"RTN","SAMIHOM4",53,0)
 . quit
"RTN","SAMIHOM4",54,0)
 ;
"RTN","SAMIHOM4",55,0)
 if $g(SAMIFILTER("samiroute"))'="" do  quit  ; workaround for "get" access to pages
"RTN","SAMIHOM4",56,0)
 . new SAMIBODY set SAMIBODY(1)=""
"RTN","SAMIHOM4",57,0)
 . do WSVAPALS^SAMIHOM3(.SAMIFILTER,.SAMIBODY,.SAMIRTN)
"RTN","SAMIHOM4",58,0)
 ;
"RTN","SAMIHOM4",59,0)
 if $get(SAMIFILTER("dfn"))'="" do  quit  ; V4W/DLW - workaround for "get" access from CPRS
"RTN","SAMIHOM4",60,0)
 . new dfn set dfn=$get(SAMIFILTER("dfn"))
"RTN","SAMIHOM4",61,0)
 . new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMIHOM4",62,0)
 . new studyid set studyid=$get(@root@(dfn,"samistudyid"))
"RTN","SAMIHOM4",63,0)
 . new SAMIBODY
"RTN","SAMIHOM4",64,0)
 . if studyid'="" do
"RTN","SAMIHOM4",65,0)
 . . set SAMIBODY(1)="samiroute=casereview&dfn="_dfn_"&studyid="_studyid
"RTN","SAMIHOM4",66,0)
 . else  do
"RTN","SAMIHOM4",67,0)
 . . set SAMIBODY(1)="samiroute=lookup&dfn="_dfn_"&studyid="_studyid
"RTN","SAMIHOM4",68,0)
 . do WSVAPALS^SAMIHOM3(.SAMIFILTER,.SAMIBODY,.SAMIRTN)
"RTN","SAMIHOM4",69,0)
 ;
"RTN","SAMIHOM4",70,0)
 do GETHOME^SAMIHOM3(.SAMIRTN,.SAMIFILTER) ; VAPALS homepage
"RTN","SAMIHOM4",71,0)
 ;
"RTN","SAMIHOM4",72,0)
 ;@stanza 3 termination
"RTN","SAMIHOM4",73,0)
 ;
"RTN","SAMIHOM4",74,0)
 quit  ; end of WSHOME
"RTN","SAMIHOM4",75,0)
 ;
"RTN","SAMIHOM4",76,0)
 ;
"RTN","SAMIHOM4",77,0)
WSVAPALS ; vapals post web service - all calls come through this gateway
"RTN","SAMIHOM4",78,0)
 ; WSVAPALS^SAMIHOM3(SAMIARG,SAMIBODY,SAMIRESULT) goto WSVAPALS^SAMIHOM4
"RTN","SAMIHOM4",79,0)
 k ^SAMIUL("vapals")
"RTN","SAMIHOM4",80,0)
 m ^SAMIUL("vapals")=SAMIARG
"RTN","SAMIHOM4",81,0)
 m ^SAMIUL("vapals","BODY")=SAMIBODY
"RTN","SAMIHOM4",82,0)
 ;
"RTN","SAMIHOM4",83,0)
 new vars,SAMIBDY
"RTN","SAMIHOM4",84,0)
 set SAMIBDY=$get(SAMIBODY(1))
"RTN","SAMIHOM4",85,0)
 do parseBody^%wf("vars",.SAMIBDY)
"RTN","SAMIHOM4",86,0)
 m vars=SAMIARG
"RTN","SAMIHOM4",87,0)
 i $g(vars("siteid"))'="" d  ;
"RTN","SAMIHOM4",88,0)
 . i $g(vars("site"))'=$g(vars("siteid")) s vars("site")=$g(vars("siteid"))
"RTN","SAMIHOM4",89,0)
 m SAMIARG=vars
"RTN","SAMIHOM4",90,0)
 m SAMIARG=SAMIBODY
"RTN","SAMIHOM4",91,0)
 ;
"RTN","SAMIHOM4",92,0)
 ; Processing for multi-tenancy
"RTN","SAMIHOM4",93,0)
 ;
"RTN","SAMIHOM4",94,0)
 if '$d(vars("siteid")) d  ;
"RTN","SAMIHOM4",95,0)
 . if $g(vars("studyid"))="" q
"RTN","SAMIHOM4",96,0)
 . n sym s sym=$e(vars("studyid"),1,3) ; first 3 chars in studyid
"RTN","SAMIHOM4",97,0)
 . i $$SITENM2^SAMISITE(sym)=-1 q
"RTN","SAMIHOM4",98,0)
 . s vars("siteid")=sym
"RTN","SAMIHOM4",99,0)
 . s vars("site")=sym
"RTN","SAMIHOM4",100,0)
 ;
"RTN","SAMIHOM4",101,0)
 if $G(vars("site"))'="" d  ;
"RTN","SAMIHOM4",102,0)
 . n siteid s siteid=vars("site")
"RTN","SAMIHOM4",103,0)
 . s SAMIARG("siteid")=siteid
"RTN","SAMIHOM4",104,0)
 . s SAMIARG("sitetitle")=$$SITENM2^SAMISITE(siteid)_" - "_siteid
"RTN","SAMIHOM4",105,0)
 k ^gpl("siteselect")
"RTN","SAMIHOM4",106,0)
 m ^gpl("siteselect")=SAMIARG
"RTN","SAMIHOM4",107,0)
 m ^gpl("siteselect","vars")=vars
"RTN","SAMIHOM4",108,0)
 if $G(SAMIARG("siteid"))="" if '$$FINDSITE^SAMISITE(.SAMIRESULT,.SAMIARG) Q 0
"RTN","SAMIHOM4",109,0)
 new SAMISITE,SAMITITL
"RTN","SAMIHOM4",110,0)
 s SAMISITE=$G(SAMIARG("siteid"))
"RTN","SAMIHOM4",111,0)
 i $G(SAMIARG("sitetitle"))="" d  ;
"RTN","SAMIHOM4",112,0)
 . s SAMIARG("sitetitle")=$$SITENM2^SAMISITE(SAMISITE)_" - "_SAMISITE
"RTN","SAMIHOM4",113,0)
 s SAMITITL=$G(SAMIARG("sitetitle"))
"RTN","SAMIHOM4",114,0)
 m vars=SAMIARG
"RTN","SAMIHOM4",115,0)
 ;
"RTN","SAMIHOM4",116,0)
 k ^SAMIUL("vapals","vars")
"RTN","SAMIHOM4",117,0)
 merge ^SAMIUL("vapals","vars")=vars
"RTN","SAMIHOM4",118,0)
 merge ^SAMIUL("vapals","vars")=SAMIBODY
"RTN","SAMIHOM4",119,0)
 ;
"RTN","SAMIHOM4",120,0)
 n route s route=$g(vars("samiroute"))
"RTN","SAMIHOM4",121,0)
 i route=""  d GETHOME^SAMIHOM3(.SAMIRESULT,.SAMIARG) ; on error go home
"RTN","SAMIHOM4",122,0)
 ;
"RTN","SAMIHOM4",123,0)
 i route="lookup" d  q 0
"RTN","SAMIHOM4",124,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",125,0)
 . d WSLOOKUP^SAMISRC2(.SAMIARG,.SAMIBODY,.SAMIRESULT)
"RTN","SAMIHOM4",126,0)
 ;
"RTN","SAMIHOM4",127,0)
 i route="login" d  q 0
"RTN","SAMIHOM4",128,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",129,0)
 . d LOGIN^SAMISITE(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",130,0)
 ;
"RTN","SAMIHOM4",131,0)
 i route="home" d  q 0
"RTN","SAMIHOM4",132,0)
 . k ^gpl("home")
"RTN","SAMIHOM4",133,0)
 . m ^gpl("home")=SAMIARG
"RTN","SAMIHOM4",134,0)
 . s SAMIARG("samiroute")=""
"RTN","SAMIHOM4",135,0)
 . d WSHOME^SAMIHOM3(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",136,0)
 ;
"RTN","SAMIHOM4",137,0)
 i route="logout" d  q 0
"RTN","SAMIHOM4",138,0)
 . ;s SAMIARG("samiroute")="home"
"RTN","SAMIHOM4",139,0)
 . ;do WSVAPALS^SAMIHOM3(.SAMIFILTER,.SAMIARG,.SAMIRESULT)
"RTN","SAMIHOM4",140,0)
 . ;Q
"RTN","SAMIHOM4",141,0)
 . s SAMIARG("sitetitle")="Unknown Site"
"RTN","SAMIHOM4",142,0)
 . s SAMIARG("siteid")=""
"RTN","SAMIHOM4",143,0)
 . s SAMIARG("errorMessage")=""
"RTN","SAMIHOM4",144,0)
 . d RTNERR^SAMIHOM4(.SAMIRESULT,"vapals:login",.SAMIARG)
"RTN","SAMIHOM4",145,0)
 ;
"RTN","SAMIHOM4",146,0)
 i route="newcase" d  q 0
"RTN","SAMIHOM4",147,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",148,0)
 . d WSNEWCAS^SAMIHOM3(.SAMIARG,.SAMIBODY,.SAMIRESULT)
"RTN","SAMIHOM4",149,0)
 ;
"RTN","SAMIHOM4",150,0)
 i route="casereview" d  q 0
"RTN","SAMIHOM4",151,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",152,0)
 . d WSCASE^SAMICASE(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",153,0)
 ;
"RTN","SAMIHOM4",154,0)
 i route="nuform" d  q 0
"RTN","SAMIHOM4",155,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",156,0)
 . d WSNUFORM^SAMICASE(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",157,0)
 ;
"RTN","SAMIHOM4",158,0)
 i route="addform" d  q 0
"RTN","SAMIHOM4",159,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",160,0)
 . d WSNFPOST^SAMICASE(.SAMIARG,.SAMIBODY,.SAMIRESULT)
"RTN","SAMIHOM4",161,0)
 ;
"RTN","SAMIHOM4",162,0)
 i route="form" d  q 0
"RTN","SAMIHOM4",163,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",164,0)
 . d wsGetForm^%wf(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",165,0)
 ;
"RTN","SAMIHOM4",166,0)
 i route="postform" d  q 0
"RTN","SAMIHOM4",167,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",168,0)
 . d wsPostForm^%wf(.SAMIARG,.SAMIBODY,.SAMIRESULT)
"RTN","SAMIHOM4",169,0)
 . i $g(SAMIARG("form"))["siform" d  ;
"RTN","SAMIHOM4",170,0)
 . . if $$NOTE^SAMINOT1(.SAMIARG) d  ;
"RTN","SAMIHOM4",171,0)
 . . . n SAMIFILTER
"RTN","SAMIHOM4",172,0)
 . . . s SAMIFILTER("studyid")=$G(SAMIARG("studyid"))
"RTN","SAMIHOM4",173,0)
 . . . s SAMIFILTER("form")=$g(SAMIARG("form")) ;
"RTN","SAMIHOM4",174,0)
 . . . n tiuien
"RTN","SAMIHOM4",175,0)
 . . . ;s tiuien=$$SV2VISTA^SAMIVSTA(.SAMIFILTER)
"RTN","SAMIHOM4",176,0)
 . . . ;s SAMIFILTER("tiuien")=tiuien
"RTN","SAMIHOM4",177,0)
 . . . ;d SV2VSTA^SAMIVSTA(.FILTER)
"RTN","SAMIHOM4",178,0)
 . . . ;m ^SAMIUL("newFILTER")=SAMIFILTER
"RTN","SAMIHOM4",179,0)
 . . . d WSNOTE^SAMINOT1(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",180,0)
 . i $g(SAMIARG("form"))["fuform" d  ;
"RTN","SAMIHOM4",181,0)
 . . if $$NOTE^SAMINOT2(.SAMIARG) d  ;
"RTN","SAMIHOM4",182,0)
 . . . n SAMIFILTER
"RTN","SAMIHOM4",183,0)
 . . . s SAMIFILTER("studyid")=$G(SAMIARG("studyid"))
"RTN","SAMIHOM4",184,0)
 . . . s SAMIFILTER("form")=$g(SAMIARG("form")) ;
"RTN","SAMIHOM4",185,0)
 . . . ;n tiuien
"RTN","SAMIHOM4",186,0)
 . . . ;s tiuien=$$SV2VISTA^SAMIVSTA(.SAMIFILTER)
"RTN","SAMIHOM4",187,0)
 . . . ;s SAMIFILTER("tiuien")=tiuien
"RTN","SAMIHOM4",188,0)
 . . . ;d SV2VSTA^SAMIVSTA(.FILTER)
"RTN","SAMIHOM4",189,0)
 . . . ;m ^SAMIUL("newFILTER")=SAMIFILTER
"RTN","SAMIHOM4",190,0)
 . . . d WSNOTE^SAMINOT2(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",191,0)
 . . e  d WSCASE^SAMICASE(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",192,0)
 ;
"RTN","SAMIHOM4",193,0)
 i route="deleteform" d  q 0
"RTN","SAMIHOM4",194,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",195,0)
 . d DELFORM^SAMICASE(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",196,0)
 ;
"RTN","SAMIHOM4",197,0)
 i route="ctreport" d  q 0
"RTN","SAMIHOM4",198,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",199,0)
 . n format s format="html"
"RTN","SAMIHOM4",200,0)
 . s format="text"
"RTN","SAMIHOM4",201,0)
 . i format="text" d WSNOTE^SAMINOT3(.SAMIRESULT,.SAMIARG) q  ;
"RTN","SAMIHOM4",202,0)
 . i format="html" d WSREPORT^SAMICTR0(.SAMIRESULT,.SAMIARG) q  ;
"RTN","SAMIHOM4",203,0)
 . ;d wsReport^SAMICTRT(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",204,0)
 ;
"RTN","SAMIHOM4",205,0)
 i route="note" d  q 0
"RTN","SAMIHOM4",206,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",207,0)
 . d WSNOTE^SAMINOT1(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",208,0)
 ;
"RTN","SAMIHOM4",209,0)
 i route="report" d  q 0 
"RTN","SAMIHOM4",210,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",211,0)
 . d WSREPORT^SAMIUR(.SAMIRESULT,.vars)
"RTN","SAMIHOM4",212,0)
 ;
"RTN","SAMIHOM4",213,0)
 i route="addperson" d  q 0
"RTN","SAMIHOM4",214,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",215,0)
 . n form
"RTN","SAMIHOM4",216,0)
 . s form="vapals:addperson"
"RTN","SAMIHOM4",217,0)
 . d RTNPAGE^SAMIHOM4(.SAMIRESULT,form,.SAMIARG) q  ;
"RTN","SAMIHOM4",218,0)
 ;
"RTN","SAMIHOM4",219,0)
 i route="editperson" d  q 0
"RTN","SAMIHOM4",220,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",221,0)
 . n dfn s dfn=$g(vars("dfn")) ; must have a dfn
"RTN","SAMIHOM4",222,0)
 . i dfn="" d  q  ;
"RTN","SAMIHOM4",223,0)
 . . d GETHOME^SAMIHOM3(.SAMIRESULT,.SAMIARG) ; on error go home 
"RTN","SAMIHOM4",224,0)
 . n root s root=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",225,0)
 . n sien s sien=$o(@root@("dfn",dfn,""))
"RTN","SAMIHOM4",226,0)
 . i sien="" d  q  ;
"RTN","SAMIHOM4",227,0)
 . . d GETHOME^SAMIHOM3(.SAMIRESULT,.SAMIARG) ; on error go home 
"RTN","SAMIHOM4",228,0)
 . s vars("name")=$g(@root@(sien,"saminame"))
"RTN","SAMIHOM4",229,0)
 . s tdob=$g(@root@(sien,"dob"))
"RTN","SAMIHOM4",230,0)
 . s vars("dob")=$p(tdob,"-",2)_"/"_$p(tdob,"-",3)_"/"_$p(tdob,"-",1)
"RTN","SAMIHOM4",231,0)
 . s vars("sbdob")=$g(@root@(sien,"dob"))
"RTN","SAMIHOM4",232,0)
 . s vars("gender")=$g(@root@(sien,"sex"))
"RTN","SAMIHOM4",233,0)
 . s vars("icn")=$g(@root@(sien,"icn"))
"RTN","SAMIHOM4",234,0)
 . n tssn s tssn=$g(@root@(sien,"ssn"))
"RTN","SAMIHOM4",235,0)
 . s vars("ssn")=$e(tssn,1,3)_"-"_$e(tssn,4,5)_"-"_$e(tssn,6,9)
"RTN","SAMIHOM4",236,0)
 . s vars("last5")=$g(@root@(sien,"last5"))
"RTN","SAMIHOM4",237,0)
 . s vars("dfn")=$g(@root@(sien,"dfn"))
"RTN","SAMIHOM4",238,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",239,0)
 . n form,err,zhtml
"RTN","SAMIHOM4",240,0)
 . s form="vapals:editparticipant"
"RTN","SAMIHOM4",241,0)
 . d RTNPAGE^SAMIHOM4(.SAMIRESULT,form,.SAMIARG) q  ;
"RTN","SAMIHOM4",242,0)
 ;
"RTN","SAMIHOM4",243,0)
 i route="register" d  q 0
"RTN","SAMIHOM4",244,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",245,0)
 . d REG^SAMIHOM4(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",246,0)
 ; 
"RTN","SAMIHOM4",247,0)
 i route="editsave" d  q 0
"RTN","SAMIHOM4",248,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",249,0)
 . d SAVE^SAMIHOM4(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",250,0)
 ;
"RTN","SAMIHOM4",251,0)
 i route="merge" d  q 0
"RTN","SAMIHOM4",252,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",253,0)
 . d MERGE^SAMIHOM4(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",254,0)
 ;
"RTN","SAMIHOM4",255,0)
 quit 0  ; End of WSVAPALS
"RTN","SAMIHOM4",256,0)
 ;
"RTN","SAMIHOM4",257,0)
 ;
"RTN","SAMIHOM4",258,0)
REG(SAMIRTN,SAMIARG) ; manual registration
"RTN","SAMIHOM4",259,0)
 ;
"RTN","SAMIHOM4",260,0)
 n name s name=$g(SAMIARG("name"))
"RTN","SAMIHOM4",261,0)
 ;
"RTN","SAMIHOM4",262,0)
 m ^gpl("reg")=SAMIARG
"RTN","SAMIHOM4",263,0)
 n ssn s ssn=SAMIARG("ssn")
"RTN","SAMIHOM4",264,0)
 s ssn=$tr(ssn,"-")
"RTN","SAMIHOM4",265,0)
 s SAMIARG("errorMessage")=""
"RTN","SAMIHOM4",266,0)
 s SAMIARG("errorField")=""
"RTN","SAMIHOM4",267,0)
 ; test for duplicate ssn
"RTN","SAMIHOM4",268,0)
 ;
"RTN","SAMIHOM4",269,0)
 i $$DUPSSN(ssn) d  ;
"RTN","SAMIHOM4",270,0)
 . ;s SAMIARG("errorMessage")=SAMIARG("errorMessage")_" Duplicate SSN."
"RTN","SAMIHOM4",271,0)
 . s SAMIARG("errorMessage")=SAMIARG("errorMessage")_" Duplicate SSN error. A person with that SSN is already entered in the system."
"RTN","SAMIHOM4",272,0)
 . s SAMIARG("errorField")="ssn"
"RTN","SAMIHOM4",273,0)
 ;
"RTN","SAMIHOM4",274,0)
 ; test for duplicate icn
"RTN","SAMIHOM4",275,0)
 ;
"RTN","SAMIHOM4",276,0)
 ;n icn s icn=$g(SAMIARG("icn"))
"RTN","SAMIHOM4",277,0)
 ;i icn'="" i $$DUPICN(icn) d  ;
"RTN","SAMIHOM4",278,0)
 ;. s SAMIARG("errorMessage")=SAMIARG("errorMessage")_" Duplicate ICN error. A person with that ICN is already entered in the system."
"RTN","SAMIHOM4",279,0)
 ;. s SAMIARG("errorField")="icn"
"RTN","SAMIHOM4",280,0)
 ;;
"RTN","SAMIHOM4",281,0)
 ;; test for wellformed ICN
"RTN","SAMIHOM4",282,0)
 ;;
"RTN","SAMIHOM4",283,0)
 ;i icn'="" i $$BADICN(icn) d  ;
"RTN","SAMIHOM4",284,0)
 ;. s SAMIARG("errorMessage")=SAMIARG("errorMessage")_" Invalid ICN error. The check digits in the ICN do not match"
"RTN","SAMIHOM4",285,0)
 ;. s SAMIARG("errorField")="icn"
"RTN","SAMIHOM4",286,0)
 ;;
"RTN","SAMIHOM4",287,0)
 ; if there is an error, send back to edit with error message
"RTN","SAMIHOM4",288,0)
 i $g(SAMIARG("errorMessage"))'="" d  q  ;
"RTN","SAMIHOM4",289,0)
 . n form
"RTN","SAMIHOM4",290,0)
 . s form="vapals:addperson"
"RTN","SAMIHOM4",291,0)
 . d RTNERR(.SAMIRESULT,form,.SAMIARG)
"RTN","SAMIHOM4",292,0)
 ;
"RTN","SAMIHOM4",293,0)
 n root s root=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",294,0)
 n proot s proot=$$setroot^%wd("vapals-patients")
"RTN","SAMIHOM4",295,0)
 n ptlkien s ptlkien=""
"RTN","SAMIHOM4",296,0)
 n dfn s dfn=""
"RTN","SAMIHOM4",297,0)
 n sien s sien=""
"RTN","SAMIHOM4",298,0)
 i ptlkien="" s ptlkien=$o(@root@("AAAAAA"),-1)+1
"RTN","SAMIHOM4",299,0)
 n zm
"RTN","SAMIHOM4",300,0)
 k SAMIARG("MATCHLOG")
"RTN","SAMIHOM4",301,0)
 s zm=$$REMATCH(sien,.SAMIARG)
"RTN","SAMIHOM4",302,0)
 i zm>0 d  ;
"RTN","SAMIHOM4",303,0)
 . s SAMIARG("MATCHLOG")=zm
"RTN","SAMIHOM4",304,0)
 d MKPTLK(ptlkien,.SAMIARG) ; make the patient-lookup record
"RTN","SAMIHOM4",305,0)
 ;
"RTN","SAMIHOM4",306,0)
 s dfn=$o(@root@("dfn"," "),-1)+1
"RTN","SAMIHOM4",307,0)
 n pdfn
"RTN","SAMIHOM4",308,0)
 s pdfn=$o(@proot@("dfn"," "),-1)+1
"RTN","SAMIHOM4",309,0)
 i pdfn>dfn s dfn=pdfn ; need a dfn that has not been used
"RTN","SAMIHOM4",310,0)
 i dfn<9000001 s dfn=9000001
"RTN","SAMIHOM4",311,0)
 s @root@(ptlkien,"dfn")=dfn
"RTN","SAMIHOM4",312,0)
 d INDXPTLK(ptlkien)
"RTN","SAMIHOM4",313,0)
 s SAMIFILTER("samiroute")="addperson"
"RTN","SAMIHOM4",314,0)
 s SAMIFILTER("siteid")=$G(SAMIARG("siteid"))
"RTN","SAMIHOM4",315,0)
 s SAMIFILTER("sitetitle")=$G(SAMIARG("sitetitle"))
"RTN","SAMIHOM4",316,0)
 k SAMIARG ; return to a blank manual registration form
"RTN","SAMIHOM4",317,0)
 s SAMIARG("siteid")=$G(SAMIFILTER("siteid"))
"RTN","SAMIHOM4",318,0)
 s SAMIARG("sitetitle")=$G(SAMIFILTER("sitetitle"))
"RTN","SAMIHOM4",319,0)
 d SETINFO(.SAMIFILTER,name_" was successfully entered")
"RTN","SAMIHOM4",320,0)
 ;d SETWARN(.SAMIFILTER,"We might want to give you a warning")
"RTN","SAMIHOM4",321,0)
 do WSVAPALS^SAMIHOM3(.SAMIFILTER,.SAMIARG,.SAMIRESULT)
"RTN","SAMIHOM4",322,0)
 q
"RTN","SAMIHOM4",323,0)
 ;
"RTN","SAMIHOM4",324,0)
MKPTLK(ptlkien,SAMIARG) ; creates the patient-lookup record
"RTN","SAMIHOM4",325,0)
 n ssn s ssn=SAMIARG("ssn")
"RTN","SAMIHOM4",326,0)
 s ssn=$tr(ssn,"-")
"RTN","SAMIHOM4",327,0)
 n name s name=$g(SAMIARG("name"))
"RTN","SAMIHOM4",328,0)
 n sinamef,sinamel
"RTN","SAMIHOM4",329,0)
 s sinamel=$p(name,","),sinamel=$$TRIM^XLFSTR(sinamel,"LR")
"RTN","SAMIHOM4",330,0)
 s sinamef=$p(name,",",2),sinamef=$$TRIM^XLFSTR(sinamef,"LR")
"RTN","SAMIHOM4",331,0)
 s name=sinamel_","_sinamef
"RTN","SAMIHOM4",332,0)
 n siteid s siteid=$g(SAMIARG("siteid"))
"RTN","SAMIHOM4",333,0)
 i siteid="" s siteid=$g(SAMIARG("site"))
"RTN","SAMIHOM4",334,0)
 ;
"RTN","SAMIHOM4",335,0)
 s @root@(ptlkien,"siteid")=siteid
"RTN","SAMIHOM4",336,0)
 s @root@(ptlkien,"saminame")=name
"RTN","SAMIHOM4",337,0)
 s @root@(ptlkien,"sinamef")=sinamef
"RTN","SAMIHOM4",338,0)
 s @root@(ptlkien,"sinamel")=sinamel
"RTN","SAMIHOM4",339,0)
 n fmdob s fmdob=$$FMDT^SAMIUR2(SAMIARG("dob"))
"RTN","SAMIHOM4",340,0)
 n ptlkdob s ptlkdob=$$FMTE^XLFDT(fmdob,7)
"RTN","SAMIHOM4",341,0)
 s ptlkdob=$TR(ptlkdob,"/","-")
"RTN","SAMIHOM4",342,0)
 s @root@(ptlkien,"dob")=ptlkdob
"RTN","SAMIHOM4",343,0)
 s @root@(ptlkien,"sbdob")=ptlkdob
"RTN","SAMIHOM4",344,0)
 n gender s gender=SAMIARG("gender")
"RTN","SAMIHOM4",345,0)
 s @root@(ptlkien,"gender")=$s(gender="M":"M^MALE",1:"F^FEMALE")
"RTN","SAMIHOM4",346,0)
 s @root@(ptlkien,"sex")=SAMIARG("gender")
"RTN","SAMIHOM4",347,0)
 s @root@(ptlkien,"icn")=SAMIARG("icn")
"RTN","SAMIHOM4",348,0)
 s @root@(ptlkien,"ssn")=ssn
"RTN","SAMIHOM4",349,0)
 n last5 s last5=$$UCASE($e(name,1))_$e(ssn,6,9)
"RTN","SAMIHOM4",350,0)
 s @root@(ptlkien,"last5")=last5
"RTN","SAMIHOM4",351,0)
 n mymatch s mymatch=$g(SAMIARG("MATCHLOG"))
"RTN","SAMIHOM4",352,0)
 i mymatch'="" s @root@(ptlkien,"MATCHLOG")=mymatch
"RTN","SAMIHOM4",353,0)
 q
"RTN","SAMIHOM4",354,0)
 ;
"RTN","SAMIHOM4",355,0)
UPDTFRMS(dfn) ; update demographics in all patient forms for patient dfn
"RTN","SAMIHOM4",356,0)
 ;
"RTN","SAMIHOM4",357,0)
 n lroot s lroot=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",358,0)
 n proot s proot=$$setroot^%wd("vapals-patients")
"RTN","SAMIHOM4",359,0)
 n lien s lien=$o(@lroot@("dfn",dfn,""))
"RTN","SAMIHOM4",360,0)
 q:lien=""
"RTN","SAMIHOM4",361,0)
 n pien s pien=$o(@proot@("dfn",dfn,""))
"RTN","SAMIHOM4",362,0)
 q:pien=""
"RTN","SAMIHOM4",363,0)
 ; this patient has forms
"RTN","SAMIHOM4",364,0)
 m @proot@(pien)=@lroot@(lien) ; refresh the demos in the patient record
"RTN","SAMIHOM4",365,0)
 n ssn s ssn=$g(@proot@(pien,"ssn"))
"RTN","SAMIHOM4",366,0)
 s @proot@(pien,"sissn")=$e(ssn,1,3)_"-"_$e(ssn,4,5)_"-"_$e(ssn,6,9)
"RTN","SAMIHOM4",367,0)
 n sid s sid=$g(@proot@("sisid")) ; studyid 
"RTN","SAMIHOM4",368,0)
 q:sid=""  ; no studyid
"RTN","SAMIHOM4",369,0)
 n zi s zi=""
"RTN","SAMIHOM4",370,0)
 f  s zi=$o(@proot@("graph",sid,zi)) q:zi=""  d  ; for each form
"RTN","SAMIHOM4",371,0)
 . m @proot@("graph",sid,zi)=@proot@(pien) ; stamp each form with new demos
"RTN","SAMIHOM4",372,0)
 q
"RTN","SAMIHOM4",373,0)
 ;
"RTN","SAMIHOM4",374,0)
MERGE(SAMIRESULT,SAMIARGS) ; merge participant records
"RTN","SAMIHOM4",375,0)
 ; called from pressing the merge button on the unmatched report
"RTN","SAMIHOM4",376,0)
 n toien s toien=$g(SAMIARGS("toien"))
"RTN","SAMIHOM4",377,0)
 i toien="" d  q  ;
"RTN","SAMIHOM4",378,0)
 . d WSUNMAT(.SAMIRESULT,.SAMIARGS)
"RTN","SAMIHOM4",379,0)
 n lroot s lroot=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",380,0)
 n fromien s fromien=$g(@lroot@(toien,"MATCHLOG"))
"RTN","SAMIHOM4",381,0)
 i fromien="" d  q  ;
"RTN","SAMIHOM4",382,0)
 . d WSUNMAT(.SAMIRESULT,.SAMIARGS)
"RTN","SAMIHOM4",383,0)
 ;
"RTN","SAMIHOM4",384,0)
 ; test for remotedfn in from record - not valid if absent
"RTN","SAMIHOM4",385,0)
 ;
"RTN","SAMIHOM4",386,0)
 i $g(@lroot@(fromien,"remotedfn"))="" d  q  ;
"RTN","SAMIHOM4",387,0)
 . d WSUNMAT(.SAMIRESULT,.SAMIARGS)
"RTN","SAMIHOM4",388,0)
 ;
"RTN","SAMIHOM4",389,0)
 ; remove index entries for from and to records
"RTN","SAMIHOM4",390,0)
 ;
"RTN","SAMIHOM4",391,0)
 d UNINDXPT(fromien) ; delete index entries
"RTN","SAMIHOM4",392,0)
 d UNINDXPT(toien)
"RTN","SAMIHOM4",393,0)
 ;
"RTN","SAMIHOM4",394,0)
 ; create changelog entry in to record - contains from record
"RTN","SAMIHOM4",395,0)
 ;
"RTN","SAMIHOM4",396,0)
 m @lroot@(toien,"changelog",$$FMTE^XLFDT($$NOW^XLFDT,5))=@lroot@(fromien)
"RTN","SAMIHOM4",397,0)
 ;
"RTN","SAMIHOM4",398,0)
 ; change the dfn in the from record to the to record dfn for merging
"RTN","SAMIHOM4",399,0)
 ;
"RTN","SAMIHOM4",400,0)
 s @lroot@(fromien,"dfn")=@lroot@(toien,"dfn")
"RTN","SAMIHOM4",401,0)
 n dfn s dfn=@lroot@(toien,"dfn") ; for use in updating forms
"RTN","SAMIHOM4",402,0)
 ;
"RTN","SAMIHOM4",403,0)
 ; merge the from record to the to record
"RTN","SAMIHOM4",404,0)
 ;
"RTN","SAMIHOM4",405,0)
 m @lroot@(toien)=@lroot@(fromien)
"RTN","SAMIHOM4",406,0)
 ;
"RTN","SAMIHOM4",407,0)
 ; delete the from record
"RTN","SAMIHOM4",408,0)
 ;
"RTN","SAMIHOM4",409,0)
 k @lroot@(fromien)
"RTN","SAMIHOM4",410,0)
 ;
"RTN","SAMIHOM4",411,0)
 ; reindex the to record
"RTN","SAMIHOM4",412,0)
 ;
"RTN","SAMIHOM4",413,0)
 d INDXPTLK(toien)
"RTN","SAMIHOM4",414,0)
 ;
"RTN","SAMIHOM4",415,0)
 ; propagate the updated from record to every form
"RTN","SAMIHOM4",416,0)
 ;
"RTN","SAMIHOM4",417,0)
 d UPDTFRMS(dfn) ; updates the patient in the vapals-patient graph
"RTN","SAMIHOM4",418,0)
 ;
"RTN","SAMIHOM4",419,0)
 ; leave and return to the unmatched report
"RTN","SAMIHOM4",420,0)
 ;   note that the form and to records will no longer be in the report
"RTN","SAMIHOM4",421,0)
 ;
"RTN","SAMIHOM4",422,0)
 d WSUNMAT(.SAMIRESULT,.SAMIARGS)
"RTN","SAMIHOM4",423,0)
 ;
"RTN","SAMIHOM4",424,0)
 q
"RTN","SAMIHOM4",425,0)
 ;
"RTN","SAMIHOM4",426,0)
ADDUNMAT ; adds the unmatched report web service to the system
"RTN","SAMIHOM4",427,0)
 ;
"RTN","SAMIHOM4",428,0)
 d addService^%webutils("GET","unmatched","WSUNMAT^SAMIHOM4")
"RTN","SAMIHOM4",429,0)
 q
"RTN","SAMIHOM4",430,0)
 ;
"RTN","SAMIHOM4",431,0)
DELUNMAT ; deletes the unmatched web service
"RTN","SAMIHOM4",432,0)
 ;
"RTN","SAMIHOM4",433,0)
 d deleteService^%webutils("GET","unmatched")
"RTN","SAMIHOM4",434,0)
 q
"RTN","SAMIHOM4",435,0)
 ;
"RTN","SAMIHOM4",436,0)
WSUNMAT(SAMIRESULT,SAMIARGS) ; navigates to unmatched report
"RTN","SAMIHOM4",437,0)
 ; 
"RTN","SAMIHOM4",438,0)
 n filter,bdy
"RTN","SAMIHOM4",439,0)
 s bdy=""
"RTN","SAMIHOM4",440,0)
 ;s filter("siteid")="PHX"
"RTN","SAMIHOM4",441,0)
 s filter("samiroute")="report"
"RTN","SAMIHOM4",442,0)
 s filter("samireporttype")="unmatched"
"RTN","SAMIHOM4",443,0)
 d WSVAPALS^SAMIHOM3(.filter,.bdy,.SAMIRESULT) ; back to the unmatched report
"RTN","SAMIHOM4",444,0)
 q
"RTN","SAMIHOM4",445,0)
 ;
"RTN","SAMIHOM4",446,0)
DUPSSN(ssn) ; extrinsic returns true if duplicate ssn
"RTN","SAMIHOM4",447,0)
 n proot s proot=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",448,0)
 i $d(@proot@("ssn",ssn)) q 1
"RTN","SAMIHOM4",449,0)
 q 0
"RTN","SAMIHOM4",450,0)
 ;
"RTN","SAMIHOM4",451,0)
DUPICN(icn) ; extrinsic returns true if duplicate icn
"RTN","SAMIHOM4",452,0)
 n proot s proot=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",453,0)
 n tmpicn s tmpicn=$p(icn,"V",1)
"RTN","SAMIHOM4",454,0)
 i $d(@proot@("icn",icn)) q 1
"RTN","SAMIHOM4",455,0)
 i $d(@proot@("icn",tmpicn)) q 1
"RTN","SAMIHOM4",456,0)
 q 0
"RTN","SAMIHOM4",457,0)
 ;
"RTN","SAMIHOM4",458,0)
BADICN(icn) ; extrinsic returns true if ICN checkdigits are wrong
"RTN","SAMIHOM4",459,0)
 n zchk s zchk=$p(icn,"V",2)
"RTN","SAMIHOM4",460,0)
 n zicn s zicn=$p(icn,"V",1)
"RTN","SAMIHOM4",461,0)
 q:zchk="" 1
"RTN","SAMIHOM4",462,0)
 i zchk'=$$CHECKDG^MPIFSPC(zicn) q 1
"RTN","SAMIHOM4",463,0)
 q 0
"RTN","SAMIHOM4",464,0)
 ;
"RTN","SAMIHOM4",465,0)
SAVE(SAMIRESULT,SAMIARG) ; save patient-lookup record after edit
"RTN","SAMIHOM4",466,0)
 ;
"RTN","SAMIHOM4",467,0)
 n dfn s dfn=$g(vars("dfn")) ; must have a dfn
"RTN","SAMIHOM4",468,0)
 i dfn="" d  q  ;
"RTN","SAMIHOM4",469,0)
 . d GETHOME^SAMIHOM3(.SAMIRESULT,.SAMIARG) ; on error go home 
"RTN","SAMIHOM4",470,0)
 n root s root=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",471,0)
 n sien s sien=$o(@root@("dfn",dfn,""))
"RTN","SAMIHOM4",472,0)
 i sien="" d  q  ;
"RTN","SAMIHOM4",473,0)
 . d GETHOME^SAMIHOM3(.SAMIRESULT,.SAMIARG) ; on error go home 
"RTN","SAMIHOM4",474,0)
 d UNINDXPT(sien) ; remove old index entries
"RTN","SAMIHOM4",475,0)
 n zm
"RTN","SAMIHOM4",476,0)
 k SAMIARG("MATCHLOG")
"RTN","SAMIHOM4",477,0)
 s zm=$$REMATCH(sien,.SAMIARG)
"RTN","SAMIHOM4",478,0)
 i zm>0 d  ;
"RTN","SAMIHOM4",479,0)
 . s SAMIARG("MATCHLOG")=zm
"RTN","SAMIHOM4",480,0)
 d MKPTLK(sien,.SAMIARG) ; add the updated fields
"RTN","SAMIHOM4",481,0)
 d INDXPTLK(sien) ; create new index entries
"RTN","SAMIHOM4",482,0)
 d UPDTFRMS(dfn) ; update demographic info in all forms
"RTN","SAMIHOM4",483,0)
 n filter,bdy
"RTN","SAMIHOM4",484,0)
 s bdy=""
"RTN","SAMIHOM4",485,0)
 m filter=SAMIARG
"RTN","SAMIHOM4",486,0)
 s filter("samiroute")="report"
"RTN","SAMIHOM4",487,0)
 s filter("samireporttype")="unmatched"
"RTN","SAMIHOM4",488,0)
 d WSVAPALS^SAMIHOM3(.filter,.bdy,.SAMIRESULT) ; back to the unmatched report
"RTN","SAMIHOM4",489,0)
 q
"RTN","SAMIHOM4",490,0)
 ;
"RTN","SAMIHOM4",491,0)
REMATCH(sien,SAMIARG) ; extrinsic returns a possible match ien
"RTN","SAMIHOM4",492,0)
 ; else zero
"RTN","SAMIHOM4",493,0)
 n lroot s lroot=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",494,0)
 n ssn,name,icn,x,y
"RTN","SAMIHOM4",495,0)
 s ssn=$g(SAMIARG("ssn"))
"RTN","SAMIHOM4",496,0)
 i ssn["-" s ssn=$tr(ssn,"-")
"RTN","SAMIHOM4",497,0)
 s name=$g(SAMIARG("saminame"))
"RTN","SAMIHOM4",498,0)
 i name="" s name=$g(SAMIARG("name"))
"RTN","SAMIHOM4",499,0)
 s icn=$g(SAMIARG("icn"))
"RTN","SAMIHOM4",500,0)
 s x=0
"RTN","SAMIHOM4",501,0)
 i ssn'="" s x=$o(@lroot@("ssn",ssn,""))
"RTN","SAMIHOM4",502,0)
 i x=sien s x=$o(@lroot@("ssn",ssn,x))
"RTN","SAMIHOM4",503,0)
 i +x'=0 d  ;
"RTN","SAMIHOM4",504,0)
 . s y=$g(@lroot@(x,"dfn"))
"RTN","SAMIHOM4",505,0)
 . i y>9000000 s x=0
"RTN","SAMIHOM4",506,0)
 i x>0 q x
"RTN","SAMIHOM4",507,0)
 i name'="" s x=$o(@lroot@("name",name,""))
"RTN","SAMIHOM4",508,0)
 i x=sien s x=$o(@lroot@("name",name,x))
"RTN","SAMIHOM4",509,0)
 i +x'=0 d  ;
"RTN","SAMIHOM4",510,0)
 . s y=$g(@lroot@(x,"dfn"))
"RTN","SAMIHOM4",511,0)
 . i y>9000000 s x=0
"RTN","SAMIHOM4",512,0)
 i x>0 q x
"RTN","SAMIHOM4",513,0)
 ;i icn'="" s x=$o(@lroot@("icn",icn,""))
"RTN","SAMIHOM4",514,0)
 ;i x=sien s x=$o(@lroot@("icn",icn,x))
"RTN","SAMIHOM4",515,0)
 ;i +x'=0 d  ;
"RTN","SAMIHOM4",516,0)
 ;. s y=$g(@lroot@(x,"dfn"))
"RTN","SAMIHOM4",517,0)
 ;. i y>9000000 s x=0
"RTN","SAMIHOM4",518,0)
 ;i x>0 q x
"RTN","SAMIHOM4",519,0)
 q 0
"RTN","SAMIHOM4",520,0)
 ;
"RTN","SAMIHOM4",521,0)
SETINFO(vars,msg) ; set the information message text
"RTN","SAMIHOM4",522,0)
 ; vars are the screen variables passed by reference
"RTN","SAMIHOM4",523,0)
 s vars("infoMessage")=msg
"RTN","SAMIHOM4",524,0)
 q
"RTN","SAMIHOM4",525,0)
 ;
"RTN","SAMIHOM4",526,0)
SETWARN(vars,msg) ; set warning message text
"RTN","SAMIHOM4",527,0)
 ; vars are the screen variables passed by reference
"RTN","SAMIHOM4",528,0)
 s vars("warnMessage")=msg
"RTN","SAMIHOM4",529,0)
 q
"RTN","SAMIHOM4",530,0)
 ; 
"RTN","SAMIHOM4",531,0)
RTNERR(rtn,form,vals,msg,fld) ; redisplays a page with an error message
"RTN","SAMIHOM4",532,0)
 ; rtn is the return array
"RTN","SAMIHOM4",533,0)
 ; form is the form the page requires
"RTN","SAMIHOM4",534,0)
 ; vals are the values for the page. passed by reference
"RTN","SAMIHOM4",535,0)
 ; msg is the error message to be displayed
"RTN","SAMIHOM4",536,0)
 ; fld is the name of the field where the cursor should be put
"RTN","SAMIHOM4",537,0)
 ;
"RTN","SAMIHOM4",538,0)
 n zhtml ; work area for the tempate
"RTN","SAMIHOM4",539,0)
 d SAMIHTM^%wf(.zhtml,form,.err)
"RTN","SAMIHOM4",540,0)
 d MERGEHTM^%wf(.zhtml,.vals,.err)
"RTN","SAMIHOM4",541,0)
 m rtn=zhtml
"RTN","SAMIHOM4",542,0)
 set HTTPRSP("mime")="text/html" ; set mime type
"RTN","SAMIHOM4",543,0)
 q
"RTN","SAMIHOM4",544,0)
 ;
"RTN","SAMIHOM4",545,0)
RTNPAGE(rtn,form,vals) ; displays a page
"RTN","SAMIHOM4",546,0)
 ; rtn is the return array
"RTN","SAMIHOM4",547,0)
 ; form is the form the page requires
"RTN","SAMIHOM4",548,0)
 ; vals are the values for the page. passed by reference
"RTN","SAMIHOM4",549,0)
 ;
"RTN","SAMIHOM4",550,0)
 n err
"RTN","SAMIHOM4",551,0)
 n zhtml ; work area for the tempate
"RTN","SAMIHOM4",552,0)
 d SAMIHTM^%wf(.zhtml,form,.err)
"RTN","SAMIHOM4",553,0)
 d MERGEHTM^%wf(.zhtml,.vals,.err)
"RTN","SAMIHOM4",554,0)
 m SAMIRESULT=zhtml
"RTN","SAMIHOM4",555,0)
 set HTTPRSP("mime")="text/html" ; set mime type
"RTN","SAMIHOM4",556,0)
 q
"RTN","SAMIHOM4",557,0)
 ;
"RTN","SAMIHOM4",558,0)
REINDXPL ; reindex patient lookup
"RTN","SAMIHOM4",559,0)
 n root s root=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",560,0)
 n zi s zi=0
"RTN","SAMIHOM4",561,0)
 k @root@("ssn")
"RTN","SAMIHOM4",562,0)
 k @root@("name")
"RTN","SAMIHOM4",563,0)
 k @root@("last5")
"RTN","SAMIHOM4",564,0)
 k @root@("sinamef")
"RTN","SAMIHOM4",565,0)
 k @root@("sinamel")
"RTN","SAMIHOM4",566,0)
 k @root@("icn")
"RTN","SAMIHOM4",567,0)
 f  s zi=$o(@root@(zi)) q:+zi=0  d  ;
"RTN","SAMIHOM4",568,0)
 . d INDXPTLK(zi)
"RTN","SAMIHOM4",569,0)
 q
"RTN","SAMIHOM4",570,0)
 ;
"RTN","SAMIHOM4",571,0)
INDXPTLK(ien) ; generate index entries in patient-lookup graph
"RTN","SAMIHOM4",572,0)
 ; for entry ien
"RTN","SAMIHOM4",573,0)
 n proot set proot=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",574,0)
 n name s name=$g(@proot@(ien,"saminame"))
"RTN","SAMIHOM4",575,0)
 s @proot@("name",name,ien)=""
"RTN","SAMIHOM4",576,0)
 n ucname s ucname=$$UCASE(name)
"RTN","SAMIHOM4",577,0)
 s @proot@("name",ucname,ien)=""
"RTN","SAMIHOM4",578,0)
 n x
"RTN","SAMIHOM4",579,0)
 s x=$g(@proot@(ien,"dfn")) ;w !,x
"RTN","SAMIHOM4",580,0)
 s:x'="" @proot@("dfn",x,ien)=""
"RTN","SAMIHOM4",581,0)
 s x=$g(@proot@(ien,"last5")) ;w !,x
"RTN","SAMIHOM4",582,0)
 s:x'="" @proot@("last5",x,ien)=""
"RTN","SAMIHOM4",583,0)
 s x=$g(@proot@(ien,"icn")) ;w !,x
"RTN","SAMIHOM4",584,0)
 i x'["V" d  ;
"RTN","SAMIHOM4",585,0)
 . i x="" q
"RTN","SAMIHOM4",586,0)
 . n chk s chk=$$CHECKDG^MPIFSPC(x)
"RTN","SAMIHOM4",587,0)
 . s @proot@(ien,"icn")=x_"V"_chk
"RTN","SAMIHOM4",588,0)
 . s x=x_"V"_chk
"RTN","SAMIHOM4",589,0)
 s:x'="" @proot@("icn",x,ien)=""
"RTN","SAMIHOM4",590,0)
 s x=$g(@proot@(ien,"ssn")) ;w !,x
"RTN","SAMIHOM4",591,0)
 s:x'="" @proot@("ssn",x,ien)=""
"RTN","SAMIHOM4",592,0)
 s x=$g(@proot@(ien,"sinamef")) ;w !,x
"RTN","SAMIHOM4",593,0)
 s:x'="" @proot@("sinamef",x,ien)=""
"RTN","SAMIHOM4",594,0)
 s x=$g(@proot@(ien,"sinamel")) w !,x
"RTN","SAMIHOM4",595,0)
 s:x'="" @proot@("sinamel",x,ien)=""
"RTN","SAMIHOM4",596,0)
 set @proot@("Date Last Updated")=$$HTE^XLFDT($horolog)
"RTN","SAMIHOM4",597,0)
 q
"RTN","SAMIHOM4",598,0)
 ;
"RTN","SAMIHOM4",599,0)
UNINDXPT(ien) ; remove index entries in patient-lookup graph
"RTN","SAMIHOM4",600,0)
 ; for entry ien
"RTN","SAMIHOM4",601,0)
 n proot set proot=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",602,0)
 n name s name=$g(@proot@(ien,"saminame"))
"RTN","SAMIHOM4",603,0)
 k @proot@("name",name,ien)
"RTN","SAMIHOM4",604,0)
 n ucname s ucname=$$UCASE(name)
"RTN","SAMIHOM4",605,0)
 k @proot@("name",ucname,ien)
"RTN","SAMIHOM4",606,0)
 n x
"RTN","SAMIHOM4",607,0)
 s x=$g(@proot@(ien,"dfn")) ;w !,x
"RTN","SAMIHOM4",608,0)
 k:x'="" @proot@("dfn",x,ien)
"RTN","SAMIHOM4",609,0)
 s x=$g(@proot@(ien,"last5")) ;w !,x
"RTN","SAMIHOM4",610,0)
 k:x'="" @proot@("last5",x,ien)
"RTN","SAMIHOM4",611,0)
 s x=$g(@proot@(ien,"icn")) ;w !,x
"RTN","SAMIHOM4",612,0)
 i x'["V" d  ;
"RTN","SAMIHOM4",613,0)
 . i x="" q
"RTN","SAMIHOM4",614,0)
 . n chk s chk=$$CHECKDG^MPIFSPC(x)
"RTN","SAMIHOM4",615,0)
 . s @proot@(ien,"icn")=x_"V"_chk
"RTN","SAMIHOM4",616,0)
 . s x=x_"V"_chk
"RTN","SAMIHOM4",617,0)
 k:x'="" @proot@("icn",x,ien)
"RTN","SAMIHOM4",618,0)
 s x=$g(@proot@(ien,"ssn")) ;w !,x
"RTN","SAMIHOM4",619,0)
 k:x'="" @proot@("ssn",x,ien)
"RTN","SAMIHOM4",620,0)
 s x=$g(@proot@(ien,"sinamef")) ;w !,x
"RTN","SAMIHOM4",621,0)
 k:x'="" @proot@("sinamef",x,ien)
"RTN","SAMIHOM4",622,0)
 s x=$g(@proot@(ien,"sinamel")) w !,x
"RTN","SAMIHOM4",623,0)
 k:x'="" @proot@("sinamel",x,ien)
"RTN","SAMIHOM4",624,0)
 set @proot@("Date Last Updated")=$$HTE^XLFDT($horolog)
"RTN","SAMIHOM4",625,0)
 q
"RTN","SAMIHOM4",626,0)
 ;
"RTN","SAMIHOM4",627,0)
UCASE(STR) ; extrinsic returns uppercase of STR
"RTN","SAMIHOM4",628,0)
 N X,Y
"RTN","SAMIHOM4",629,0)
 S X=STR
"RTN","SAMIHOM4",630,0)
 X ^%ZOSF("UPPERCASE")
"RTN","SAMIHOM4",631,0)
 q Y
"RTN","SAMIHOM4",632,0)
 ;
"RTN","SAMIHOM4",633,0)
DEVHOME ; temporary home page for development
"RTN","SAMIHOM4",634,0)
 ; DEVHOME^SAMIHOM3(SAMIRTN,SAMIFILTER) goto DEVHOME^SAMIHOM4
"RTN","SAMIHOM4",635,0)
 ;
"RTN","SAMIHOM4",636,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMIHOM4",637,0)
 ;
"RTN","SAMIHOM4",638,0)
 ;ven/gpl;private;procedure;
"RTN","SAMIHOM4",639,0)
 ;@called-by
"RTN","SAMIHOM4",640,0)
 ; WSHOME
"RTN","SAMIHOM4",641,0)
 ;@calls
"RTN","SAMIHOM4",642,0)
 ; htmltb2^%yottaweb
"RTN","SAMIHOM4",643,0)
 ; PATLIST
"RTN","SAMIHOM4",644,0)
 ; genhtml^%yottautl
"RTN","SAMIHOM4",645,0)
 ; addary^%yottautl
"RTN","SAMIHOM4",646,0)
 ;@input
"RTN","SAMIHOM4",647,0)
 ; SAMIFILTER =
"RTN","SAMIHOM4",648,0)
 ;@output
"RTN","SAMIHOM4",649,0)
 ;.SAMIRTN =
"RTN","SAMIHOM4",650,0)
 ;@examples [tbd]
"RTN","SAMIHOM4",651,0)
 ;@tests [tbd]
"RTN","SAMIHOM4",652,0)
 ;
"RTN","SAMIHOM4",653,0)
 ;@stanza 2 ?
"RTN","SAMIHOM4",654,0)
 ;
"RTN","SAMIHOM4",655,0)
 new gtop,gbot
"RTN","SAMIHOM4",656,0)
 do htmltb2^%yottaweb(.gtop,.gbot,"SAMI Test Patients")
"RTN","SAMIHOM4",657,0)
 ;
"RTN","SAMIHOM4",658,0)
 new html,ary,hpat
"RTN","SAMIHOM4",659,0)
 do PATLIST^SAMIHOM3("hpat")
"RTN","SAMIHOM4",660,0)
 quit:'$data(hpat)
"RTN","SAMIHOM4",661,0)
 ;
"RTN","SAMIHOM4",662,0)
 set ary("title")="SAMI Test Patients on this system"
"RTN","SAMIHOM4",663,0)
 set ary("header",1)="StudyId"
"RTN","SAMIHOM4",664,0)
 set ary("header",2)="Name"
"RTN","SAMIHOM4",665,0)
 ;
"RTN","SAMIHOM4",666,0)
 new cnt set cnt=0
"RTN","SAMIHOM4",667,0)
 new zi set zi=""
"RTN","SAMIHOM4",668,0)
 for  set zi=$order(hpat(zi)) quit:zi=""  do  ;
"RTN","SAMIHOM4",669,0)
 . set cnt=cnt+1
"RTN","SAMIHOM4",670,0)
 . new url set url="<a href=""/cform.cgi?studyId="_zi_""">"_zi_"</a>"
"RTN","SAMIHOM4",671,0)
 . set ary(cnt,1)=url
"RTN","SAMIHOM4",672,0)
 . set ary(cnt,2)=""
"RTN","SAMIHOM4",673,0)
 . quit
"RTN","SAMIHOM4",674,0)
 ;
"RTN","SAMIHOM4",675,0)
 do genhtml^%yottautl("html","ary")
"RTN","SAMIHOM4",676,0)
 ;
"RTN","SAMIHOM4",677,0)
 do addary^%yottautl("SAMIRTN","gtop")
"RTN","SAMIHOM4",678,0)
 do addary^%yottautl("SAMIRTN","html")
"RTN","SAMIHOM4",679,0)
 set SAMIRTN($order(SAMIRTN(""),-1)+1)=gbot
"RTN","SAMIHOM4",680,0)
 kill SAMIRTN(0)
"RTN","SAMIHOM4",681,0)
 ;
"RTN","SAMIHOM4",682,0)
 set HTTPRSP("mime")="text/html"
"RTN","SAMIHOM4",683,0)
 ;
"RTN","SAMIHOM4",684,0)
 ;@stanza ? termination
"RTN","SAMIHOM4",685,0)
 ;
"RTN","SAMIHOM4",686,0)
 quit  ; end of DEVHOME
"RTN","SAMIHOM4",687,0)
 ;
"RTN","SAMIHOM4",688,0)
 ;
"RTN","SAMIHOM4",689,0)
GETHOME ; homepage accessed using GET
"RTN","SAMIHOM4",690,0)
 ; GETHOME^SAMIHOM3(SAMIRTN,SAMIFILTER) goto GETHOME^SAMIHOM4
"RTN","SAMIHOM4",691,0)
 ;
"RTN","SAMIHOM4",692,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMIHOM4",693,0)
 ;
"RTN","SAMIHOM4",694,0)
 ;ven/gpl;private;procedure;
"RTN","SAMIHOM4",695,0)
 ;@called-by
"RTN","SAMIHOM4",696,0)
 ; WSHOME
"RTN","SAMIHOM4",697,0)
 ; WSNEWCAS
"RTN","SAMIHOM4",698,0)
 ; WSNFPOST^SAMICASE
"RTN","SAMIHOM4",699,0)
 ; wsLookup^SAMISRCH
"RTN","SAMIHOM4",700,0)
 ;@calls
"RTN","SAMIHOM4",701,0)
 ; GETTMPL^SAMICASE
"RTN","SAMIHOM4",702,0)
 ; findReplace^%ts
"RTN","SAMIHOM4",703,0)
 ; $$SCANFOR
"RTN","SAMIHOM4",704,0)
 ; ADDCRLF^VPRJRUT
"RTN","SAMIHOM4",705,0)
 ;@input
"RTN","SAMIHOM4",706,0)
 ; SAMIFILTER =
"RTN","SAMIHOM4",707,0)
 ;@output
"RTN","SAMIHOM4",708,0)
 ;.SAMIRTN =
"RTN","SAMIHOM4",709,0)
 ;@examples [tbd]
"RTN","SAMIHOM4",710,0)
 ;@tests [tbd]
"RTN","SAMIHOM4",711,0)
 ;
"RTN","SAMIHOM4",712,0)
 ;@stanza 2 get template for homepage
"RTN","SAMIHOM4",713,0)
 ;
"RTN","SAMIHOM4",714,0)
 ; Processing for multi-tenancy
"RTN","SAMIHOM4",715,0)
 ;
"RTN","SAMIHOM4",716,0)
 if $G(SAMIFILTER("siteid"))="" if '$$FINDSITE^SAMISITE(.SAMIRTN,.SAMIFILTER) Q 0
"RTN","SAMIHOM4",717,0)
 new SAMISITE,SAMITITL
"RTN","SAMIHOM4",718,0)
 s SAMISITE=$G(SAMIFILTER("siteid"))
"RTN","SAMIHOM4",719,0)
 s SAMITITL=$G(SAMIFILTER("sitetitle"))
"RTN","SAMIHOM4",720,0)
 ;
"RTN","SAMIHOM4",721,0)
 new temp,tout,form
"RTN","SAMIHOM4",722,0)
 s form="vapals:home"
"RTN","SAMIHOM4",723,0)
 do GETTMPL^SAMICASE("temp",form)
"RTN","SAMIHOM4",724,0)
 quit:'$data(temp)
"RTN","SAMIHOM4",725,0)
 ;
"RTN","SAMIHOM4",726,0)
 ;@stanza 3 process homepage template
"RTN","SAMIHOM4",727,0)
 ;
"RTN","SAMIHOM4",728,0)
 n err
"RTN","SAMIHOM4",729,0)
 do MERGEHTM^%wf(.temp,.SAMIFILTER,.err)
"RTN","SAMIHOM4",730,0)
 ;
"RTN","SAMIHOM4",731,0)
 ;
"RTN","SAMIHOM4",732,0)
 do ADDCRLF^VPRJRUT(.temp)
"RTN","SAMIHOM4",733,0)
 merge SAMIRTN=temp
"RTN","SAMIHOM4",734,0)
 ;
"RTN","SAMIHOM4",735,0)
 q
"RTN","SAMIHOM4",736,0)
 ;
"RTN","SAMIHOM4",737,0)
 ; below is redacted
"RTN","SAMIHOM4",738,0)
 new cnt set cnt=0
"RTN","SAMIHOM4",739,0)
 new zi set zi=0
"RTN","SAMIHOM4",740,0)
 for  set zi=$order(temp(zi)) quit:+zi=0  do  ;
"RTN","SAMIHOM4",741,0)
 . ;
"RTN","SAMIHOM4",742,0)
 . n ln s ln=temp(zi)
"RTN","SAMIHOM4",743,0)
 . n touched s touched=0
"RTN","SAMIHOM4",744,0)
 . ;
"RTN","SAMIHOM4",745,0)
 . i ln["href" i 'touched d  ;
"RTN","SAMIHOM4",746,0)
 . . d FIXHREF^SAMIFORM(.ln)
"RTN","SAMIHOM4",747,0)
 . . s temp(zi)=ln
"RTN","SAMIHOM4",748,0)
 . ;
"RTN","SAMIHOM4",749,0)
 . i ln["src" d  ;
"RTN","SAMIHOM4",750,0)
 . . d FIXSRC^SAMIFORM(.ln)
"RTN","SAMIHOM4",751,0)
 . . s temp(zi)=ln
"RTN","SAMIHOM4",752,0)
 . ;
"RTN","SAMIHOM4",753,0)
 . i ln["id" i ln["studyIdMenu" d  ;
"RTN","SAMIHOM4",754,0)
 . . s zi=zi+4
"RTN","SAMIHOM4",755,0)
 . ;
"RTN","SAMIHOM4",756,0)
 . if ln["@@MANUALREGISTRATION@@" do  ; turn off manual registration
"RTN","SAMIHOM4",757,0)
 . . n setman,setparm
"RTN","SAMIHOM4",758,0)
 . . s setman="true"
"RTN","SAMIHOM4",759,0)
 . . s setparm=$$GET^XPAR("SYS","SAMI ALLOW MANUAL ENTRY",,"Q")
"RTN","SAMIHOM4",760,0)
 . . i setparm=0 s setman="false"
"RTN","SAMIHOM4",761,0)
 . . do findReplace^%ts(.ln,"@@MANUALREGISTRATION@@",setman)
"RTN","SAMIHOM4",762,0)
 . . s temp(zi)=ln
"RTN","SAMIHOM4",763,0)
 . . quit 
"RTN","SAMIHOM4",764,0)
 . set cnt=cnt+1
"RTN","SAMIHOM4",765,0)
 . set tout(cnt)=temp(zi)
"RTN","SAMIHOM4",766,0)
 . quit
"RTN","SAMIHOM4",767,0)
 ;
"RTN","SAMIHOM4",768,0)
 ;@stanza 4 add cr/lf & save to return array
"RTN","SAMIHOM4",769,0)
 ;
"RTN","SAMIHOM4",770,0)
 do ADDCRLF^VPRJRUT(.tout)
"RTN","SAMIHOM4",771,0)
 merge SAMIRTN=tout
"RTN","SAMIHOM4",772,0)
 ;
"RTN","SAMIHOM4",773,0)
 ;@stanza 5 termination
"RTN","SAMIHOM4",774,0)
 ;
"RTN","SAMIHOM4",775,0)
 quit  ; end of GETHOME
"RTN","SAMIHOM4",776,0)
 ;
"RTN","SAMIHOM4",777,0)
 ;
"RTN","SAMIHOM4",778,0)
WSNEWCAS ; receives post from home & creates new case
"RTN","SAMIHOM4",779,0)
 ; WSNEWCAS^SAMIHOM3(SAMIARGS,SAMIBODY,SAMIRESULT) goto WSNEWCAS^SAMIHOM4
"RTN","SAMIHOM4",780,0)
 ;
"RTN","SAMIHOM4",781,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMIHOM4",782,0)
 ;
"RTN","SAMIHOM4",783,0)
 ;ven/gpl;private;procedure;
"RTN","SAMIHOM4",784,0)
 ;@called-by
"RTN","SAMIHOM4",785,0)
 ;@calls
"RTN","SAMIHOM4",786,0)
 ; parseBody^%wf
"RTN","SAMIHOM4",787,0)
 ; $$setroot^%wd
"RTN","SAMIHOM4",788,0)
 ; $$NEXTNUM
"RTN","SAMIHOM4",789,0)
 ; $$GENSTDID^SAMIHOM3
"RTN","SAMIHOM4",790,0)
 ; $$NOW^XLFDT
"RTN","SAMIHOM4",791,0)
 ; $$KEYDATE^SAMIHOM3
"RTN","SAMIHOM4",792,0)
 ; $$VALDTNM
"RTN","SAMIHOM4",793,0)
 ; GETHOME
"RTN","SAMIHOM4",794,0)
 ; PREFILL
"RTN","SAMIHOM4",795,0)
 ; MKSBFORM
"RTN","SAMIHOM4",796,0)
 ; MKSIFORM^SAMIHOM3
"RTN","SAMIHOM4",797,0)
 ; WSCASE^SAMICASE
"RTN","SAMIHOM4",798,0)
 ;@input
"RTN","SAMIHOM4",799,0)
 ;.ARGS =
"RTN","SAMIHOM4",800,0)
 ; BODY =
"RTN","SAMIHOM4",801,0)
 ;.RESULT =
"RTN","SAMIHOM4",802,0)
 ;@output: ?
"RTN","SAMIHOM4",803,0)
 ;@examples [tbd]
"RTN","SAMIHOM4",804,0)
 ;@tests [tbd]
"RTN","SAMIHOM4",805,0)
 ;
"RTN","SAMIHOM4",806,0)
 ;@stanza 2 ?
"RTN","SAMIHOM4",807,0)
 ;
"RTN","SAMIHOM4",808,0)
 merge ^SAMIUL("newCase","ARGS")=SAMIARGS
"RTN","SAMIHOM4",809,0)
 merge ^SAMIUL("newCase","BODY")=SAMIBODY
"RTN","SAMIHOM4",810,0)
 ;
"RTN","SAMIHOM4",811,0)
 new vars,bdy
"RTN","SAMIHOM4",812,0)
 set SAMIBDY=$get(SAMIBODY(1))
"RTN","SAMIHOM4",813,0)
 do parseBody^%wf("vars",.SAMIBDY)
"RTN","SAMIHOM4",814,0)
 merge ^SAMIUL("newCase","vars")=vars
"RTN","SAMIHOM4",815,0)
 ;
"RTN","SAMIHOM4",816,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMIHOM4",817,0)
 ;
"RTN","SAMIHOM4",818,0)
 new saminame set saminame=$get(vars("name"))
"RTN","SAMIHOM4",819,0)
 if saminame="" s saminame=$get(vars("saminame"))
"RTN","SAMIHOM4",820,0)
 ;if $$VALDTNM(saminame,.ARGS)=-1 do  quit  ;
"RTN","SAMIHOM4",821,0)
 ;. new r1
"RTN","SAMIHOM4",822,0)
 ;. do GETHOME(.r1,.ARGS) ; home page to redisplay
"RTN","SAMIHOM4",823,0)
 ;. merge RESULT=r1
"RTN","SAMIHOM4",824,0)
 ;. quit
"RTN","SAMIHOM4",825,0)
 ;
"RTN","SAMIHOM4",826,0)
 new dfn s dfn=$get(vars("dfn"))
"RTN","SAMIHOM4",827,0)
 ;if dfn="" do  quit  ;
"RTN","SAMIHOM4",828,0)
 ;. new r1
"RTN","SAMIHOM4",829,0)
 ;. do GETHOME(.r1,.ARGS) ; home page to redisplay
"RTN","SAMIHOM4",830,0)
 ;. merge RESULT=r1
"RTN","SAMIHOM4",831,0)
 ;. quit
"RTN","SAMIHOM4",832,0)
 ;
"RTN","SAMIHOM4",833,0)
 ;new gien set gien=$$NEXTNUM
"RTN","SAMIHOM4",834,0)
 new gien set gien=dfn
"RTN","SAMIHOM4",835,0)
 ;
"RTN","SAMIHOM4",836,0)
 m ^SAMIUL("newCase","G1")=root
"RTN","SAMIHOM4",837,0)
 ; create dfn index
"RTN","SAMIHOM4",838,0)
 set @root@("dfn",dfn,gien)=""
"RTN","SAMIHOM4",839,0)
 ;
"RTN","SAMIHOM4",840,0)
 set @root@(gien,"saminum")=gien
"RTN","SAMIHOM4",841,0)
 set @root@(gien,"saminame")=saminame
"RTN","SAMIHOM4",842,0)
 ;
"RTN","SAMIHOM4",843,0)
 new studyid set studyid=$$GENSTDID^SAMIHOM3(gien,.SAMIARGS)
"RTN","SAMIHOM4",844,0)
 set @root@(gien,"samistudyid")=studyid
"RTN","SAMIHOM4",845,0)
 set @root@("sid",studyid,gien)=""
"RTN","SAMIHOM4",846,0)
 ;
"RTN","SAMIHOM4",847,0)
 new datekey set datekey=$$KEYDATE^SAMIHOM3($$NOW^XLFDT)
"RTN","SAMIHOM4",848,0)
 set @root@(gien,"samicreatedate")=datekey
"RTN","SAMIHOM4",849,0)
 ;
"RTN","SAMIHOM4",850,0)
 merge ^SAMIUL("newCase",gien)=@root@(gien)
"RTN","SAMIHOM4",851,0)
 ;
"RTN","SAMIHOM4",852,0)
 ;
"RTN","SAMIHOM4",853,0)
 do PREFILL^SAMIHOM3(dfn) ; prefills from the "patient-lookup" graph
"RTN","SAMIHOM4",854,0)
 ;
"RTN","SAMIHOM4",855,0)
 n siformkey
"RTN","SAMIHOM4",856,0)
 ;do makeSbform(gien) ; create a background form for new patient
"RTN","SAMIHOM4",857,0)
 set siformkey=$$MKSIFORM^SAMIHOM3(gien) ; create an intake for for new patient
"RTN","SAMIHOM4",858,0)
 ;
"RTN","SAMIHOM4",859,0)
 set SAMIARGS("studyid")=studyid
"RTN","SAMIHOM4",860,0)
 set SAMIARGS("form")="vapals:"_siformkey
"RTN","SAMIHOM4",861,0)
 do wsGetForm^%wf(.SAMIRESULT,.SAMIARGS)
"RTN","SAMIHOM4",862,0)
 ;do WSCASE^SAMICASE(.SAMIRESULT,.SAMIARGS) ; navigate to the case review page
"RTN","SAMIHOM4",863,0)
 ;
"RTN","SAMIHOM4",864,0)
 ;@stanza ? termination
"RTN","SAMIHOM4",865,0)
 ;
"RTN","SAMIHOM4",866,0)
 quit  ; end of WSNEWCAS
"RTN","SAMIHOM4",867,0)
 ;
"RTN","SAMIHOM4",868,0)
 ;
"RTN","SAMIHOM4",869,0)
EOR ; End of routine SAMIHOM4
"RTN","SAMIPTLK")
0^5^B10220412
"RTN","SAMIPTLK",1,0)
SAMIPTLK ;ven/gpl - SAMI patient lookup routines ;Dec 17, 2019@09:44
"RTN","SAMIPTLK",2,0)
 ;;18.0;SAMI;;;Build 12
"RTN","SAMIPTLK",3,0)
 ;
"RTN","SAMIPTLK",4,0)
 ;@license: see routine SAMIUL
"RTN","SAMIPTLK",5,0)
 ;
"RTN","SAMIPTLK",6,0)
 ; Authored by George P. Lilly 2018
"RTN","SAMIPTLK",7,0)
 ;
"RTN","SAMIPTLK",8,0)
 Q
"RTN","SAMIPTLK",9,0)
WSPTLOOK(rtn,filter) ; patient lookup - calls HMPPTRPC
"RTN","SAMIPTLK",10,0)
 ;
"RTN","SAMIPTLK",11,0)
 n search s search=$g(filter("search"))
"RTN","SAMIPTLK",12,0)
 n rslt
"RTN","SAMIPTLK",13,0)
 d SELECT^HMPPTRPC(.rslt,"NAME",search)
"RTN","SAMIPTLK",14,0)
 i $d(rslt) d  ;
"RTN","SAMIPTLK",15,0)
 . D ENCODE^VPRJSON("rslt","rtn")
"RTN","SAMIPTLK",16,0)
 q
"RTN","SAMIPTLK",17,0)
 ;
"RTN","SAMIPTLK",18,0)
WSPTLKUP(rtn,filter) ; patient lookup from patient-lookup cache
"RTN","SAMIPTLK",19,0)
 ;
"RTN","SAMIPTLK",20,0)
 n root s root=$$setroot^%wd("patient-lookup")
"RTN","SAMIPTLK",21,0)
 n search s search=$g(filter("search"))
"RTN","SAMIPTLK",22,0)
 n limit s limit=$g(filter("limit"))
"RTN","SAMIPTLK",23,0)
 n site s site=$g(filter("site"))
"RTN","SAMIPTLK",24,0)
 ;m ^gpl("ptlkup")=filter ;
"RTN","SAMIPTLK",25,0)
 q:site=""
"RTN","SAMIPTLK",26,0)
 i limit="" s limit=1000
"RTN","SAMIPTLK",27,0)
 s search=$$UPCASE^XLFMSMT(search)
"RTN","SAMIPTLK",28,0)
 n rslt
"RTN","SAMIPTLK",29,0)
 n cnt s cnt=0
"RTN","SAMIPTLK",30,0)
 n gn s gn=$na(@root@("name"))
"RTN","SAMIPTLK",31,0)
 n p1,p2
"RTN","SAMIPTLK",32,0)
 s p1=$p(search,",",1)
"RTN","SAMIPTLK",33,0)
 s p2=$p(search,",",2)
"RTN","SAMIPTLK",34,0)
 i $l(search)=5 i +$e(search,2,5)>0 d  q  ; using last5
"RTN","SAMIPTLK",35,0)
 . n gn2 s gn2=$na(@root@("last5"))
"RTN","SAMIPTLK",36,0)
 . n ii s ii=""
"RTN","SAMIPTLK",37,0)
 . f  s ii=$o(@gn2@(search,ii)) q:ii=""  q:cnt=limit  d  ;
"RTN","SAMIPTLK",38,0)
 . . i $g(@root@(ii,"siteid"))'=site q
"RTN","SAMIPTLK",39,0)
 . . s cnt=cnt+1
"RTN","SAMIPTLK",40,0)
 . . s rslt(cnt,ii)=""
"RTN","SAMIPTLK",41,0)
 . i cnt>0 d  ;
"RTN","SAMIPTLK",42,0)
 . . d BUILDRTN(.rtn,.rslt)
"RTN","SAMIPTLK",43,0)
 ; 
"RTN","SAMIPTLK",44,0)
 n have s have=""
"RTN","SAMIPTLK",45,0)
 n q1 s q1=$na(@gn@(p1))
"RTN","SAMIPTLK",46,0)
 n q1x s q1x=$e(q1,1,$l(q1)-2) ; removes the ")
"RTN","SAMIPTLK",47,0)
 n qx s qx=q1
"RTN","SAMIPTLK",48,0)
 f  s qx=$q(@qx) q:$p(qx,q1x,2)=""  q:cnt=limit  d  ;
"RTN","SAMIPTLK",49,0)
 . n exit s exit=0
"RTN","SAMIPTLK",50,0)
 . i p2'="" d  ;
"RTN","SAMIPTLK",51,0)
 . . i p2'=$e($p(qx,",",5),1,$l(p2)) s exit=1
"RTN","SAMIPTLK",52,0)
 . q:exit
"RTN","SAMIPTLK",53,0)
 . n qx2 s qx2=+$p(qx,",",6)
"RTN","SAMIPTLK",54,0)
 . i $g(@root@(qx2,"siteid"))'=site q  ;
"RTN","SAMIPTLK",55,0)
 . i $d(have(qx2)) q  ; already go this one
"RTN","SAMIPTLK",56,0)
 . s cnt=cnt+1
"RTN","SAMIPTLK",57,0)
 . s have(qx2)=""
"RTN","SAMIPTLK",58,0)
 . s rslt(cnt,qx2)="" ; the ien
"RTN","SAMIPTLK",59,0)
 . ;w !,qx," ien=",$o(rslt(cnt,""))
"RTN","SAMIPTLK",60,0)
 i cnt>0 d BUILDRTN(.rtn,.rslt)
"RTN","SAMIPTLK",61,0)
 q
"RTN","SAMIPTLK",62,0)
 ;
"RTN","SAMIPTLK",63,0)
BUILDRTN(rtn,ary) ; build the return json
"RTN","SAMIPTLK",64,0)
 ;
"RTN","SAMIPTLK",65,0)
 ;d ^ZTER
"RTN","SAMIPTLK",66,0)
 n root s root=$$setroot^%wd("patient-lookup")
"RTN","SAMIPTLK",67,0)
 n groot s groot=$$setroot^%wd("vapals-patients")
"RTN","SAMIPTLK",68,0)
 n zi s zi=""
"RTN","SAMIPTLK",69,0)
 n r1 s r1=""
"RTN","SAMIPTLK",70,0)
 f  s zi=$o(ary(zi)) q:zi=""  d  ;
"RTN","SAMIPTLK",71,0)
 . n rx s rx=$o(ary(zi,""))
"RTN","SAMIPTLK",72,0)
 . s r1("result",zi,"name")=$g(@root@(rx,"saminame"))
"RTN","SAMIPTLK",73,0)
 . s r1("result",zi,"dfn")=$g(@root@(rx,"dfn"))
"RTN","SAMIPTLK",74,0)
 . s r1("result",zi,"last5")=$g(@root@(rx,"last5"))
"RTN","SAMIPTLK",75,0)
 . s r1("result",zi,"gender")=$g(@root@(rx,"gender"))
"RTN","SAMIPTLK",76,0)
 . s r1("result",zi,"dob")=$g(@root@(rx,"sbdob"))
"RTN","SAMIPTLK",77,0)
 . s r1("result",zi,"vapals")=0
"RTN","SAMIPTLK",78,0)
 . n dfn s dfn=$g(@root@(rx,"dfn"))
"RTN","SAMIPTLK",79,0)
 . i $o(@groot@("dfn",dfn,""))'="" d  ;
"RTN","SAMIPTLK",80,0)
 . . s r1("result",zi,"vapals")=1
"RTN","SAMIPTLK",81,0)
 . . s r1("result",zi,"studyid")=$g(@groot@(dfn,"samistudyid"))
"RTN","SAMIPTLK",82,0)
 ;.;
"RTN","SAMIPTLK",83,0)
 ;.; ven/lgc 2019-12-17 missing forms
"RTN","SAMIPTLK",84,0)
 ;.;
"RTN","SAMIPTLK",85,0)
 ;. i '($data(@groot@("graph",@groot@(dfn,"samistudyid")))) d  ;
"RTN","SAMIPTLK",86,0)
 ;. . s r1("result",zi,"vapals")=0
"RTN","SAMIPTLK",87,0)
 ;
"RTN","SAMIPTLK",88,0)
 ;q:'$d(r1)
"RTN","SAMIPTLK",89,0)
 d ENCODE^VPRJSON("r1","rtn")
"RTN","SAMIPTLK",90,0)
 q
"RTN","SAMIPTLK",91,0)
 ;
"RTN","SAMISAV")
0^10^B22601784
"RTN","SAMISAV",1,0)
SAMISAV ;ven/gpl - SAMI save routines ; 2/14/19 12:10pm
"RTN","SAMISAV",2,0)
 ;;18.0;SAM;;;Build 12
"RTN","SAMISAV",3,0)
 ;
"RTN","SAMISAV",4,0)
 ;@license: see routine SAMIUL
"RTN","SAMISAV",5,0)
 ; 
"RTN","SAMISAV",6,0)
 ; It is currently untested & in progress.
"RTN","SAMISAV",7,0)
 ;
"RTN","SAMISAV",8,0)
 quit  ; no entry from top
"RTN","SAMISAV",9,0)
 ;
"RTN","SAMISAV",10,0)
SAVFILTR(sid,form,vars) ; extrinsic which returns the form key to use
"RTN","SAMISAV",11,0)
 ; for saving. It will relocate the graph for the form if required based
"RTN","SAMISAV",12,0)
 ; on dates entered on the form.
"RTN","SAMISAV",13,0)
 ; 
"RTN","SAMISAV",14,0)
 ; processing for multi-tenancy
"RTN","SAMISAV",15,0)
 ;   if siteid is not provided, but studyid is provided
"RTN","SAMISAV",16,0)
 ;   look up and set siteid
"RTN","SAMISAV",17,0)
 ;
"RTN","SAMISAV",18,0)
 if '$d(vars("siteid")) d  ;
"RTN","SAMISAV",19,0)
 . if $g(sid)="" q
"RTN","SAMISAV",20,0)
 . n sym s sym=$e(sid,1,3) ; first 3 chars in studyid
"RTN","SAMISAV",21,0)
 . i $$SITENM2^SAMISITE(sym)=-1 q
"RTN","SAMISAV",22,0)
 . s vars("siteid")=sym
"RTN","SAMISAV",23,0)
 . s vars("site")=sym
"RTN","SAMISAV",24,0)
 ;
"RTN","SAMISAV",25,0)
 n useform s useform=form ; by default, the form is unchanged
"RTN","SAMISAV",26,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMISAV",27,0)
 n type s type=$p(form,"-",1)
"RTN","SAMISAV",28,0)
 ;
"RTN","SAMISAV",29,0)
 if type="ceform" d  ; ct evaluation form
"RTN","SAMISAV",30,0)
 . m ^SAMIUL("samisav","vals")=vars
"RTN","SAMISAV",31,0)
 . n formdate s formdate=$g(vars("cedos")) ; date of the CT scan from the form
"RTN","SAMISAV",32,0)
 . q:formdate=""
"RTN","SAMISAV",33,0)
 . n fdate s fdate=$$KEY2FM^SAMICASE(formdate) ; convert to fileman date
"RTN","SAMISAV",34,0)
 . q:fdate=""
"RTN","SAMISAV",35,0)
 . q:fdate<0
"RTN","SAMISAV",36,0)
 . n fmcurrent s fmcurrent=$$KEY2FM^SAMICASE(form) ; current key in fm formate
"RTN","SAMISAV",37,0)
 . if fdate'=fmcurrent d  ;
"RTN","SAMISAV",38,0)
 . . n moveto s moveto="ceform-"_$$KEYDATE^SAMIHOM3(fdate)
"RTN","SAMISAV",39,0)
 . . ;w !,"old: ",fmcurrent," new: ",fdate," ... date must be changed
"RTN","SAMISAV",40,0)
 . . k ^SAMIUL("samisav")
"RTN","SAMISAV",41,0)
 . . s ^SAMIUL("samisav","current")=form_"^"_fmcurrent
"RTN","SAMISAV",42,0)
 . . s ^SAMIUL("samisav","incoming")=formdate_"^"_fdate
"RTN","SAMISAV",43,0)
 . . s ^SAMIUL("samisav","conclusion")="graph must be moved to: "_moveto
"RTN","SAMISAV",44,0)
 . . m ^SAMIUL("samisav","vals")=vars
"RTN","SAMISAV",45,0)
 . . m @root@("graph",sid,moveto)=@root@("graph",sid,form)
"RTN","SAMISAV",46,0)
 . . k @root@("graph",sid,form)
"RTN","SAMISAV",47,0)
 . . s useform=moveto
"RTN","SAMISAV",48,0)
 if type="fuform" d  ; followup form
"RTN","SAMISAV",49,0)
 . m ^SAMIUL("samisav","vals")=vars
"RTN","SAMISAV",50,0)
 . n formdate s formdate=$g(vars("sidof")) ; date of the CT scan from the form
"RTN","SAMISAV",51,0)
 . q:formdate=""
"RTN","SAMISAV",52,0)
 . n fdate s fdate=$$KEY2FM^SAMICASE(formdate) ; convert to fileman date
"RTN","SAMISAV",53,0)
 . q:fdate=""
"RTN","SAMISAV",54,0)
 . q:fdate<0
"RTN","SAMISAV",55,0)
 . n fmcurrent s fmcurrent=$$KEY2FM^SAMICASE(form) ; current key in fm formate
"RTN","SAMISAV",56,0)
 . if fdate'=fmcurrent d  ;
"RTN","SAMISAV",57,0)
 . . n moveto s moveto="fuform-"_$$KEYDATE^SAMIHOM3(fdate)
"RTN","SAMISAV",58,0)
 . . ;w !,"old: ",fmcurrent," new: ",fdate," ... date must be changed
"RTN","SAMISAV",59,0)
 . . k ^SAMIUL("samisav")
"RTN","SAMISAV",60,0)
 . . s ^SAMIUL("samisav","current")=form_"^"_fmcurrent
"RTN","SAMISAV",61,0)
 . . s ^SAMIUL("samisav","incoming")=formdate_"^"_fdate
"RTN","SAMISAV",62,0)
 . . s ^SAMIUL("samisav","conclusion")="graph must be moved to: "_moveto
"RTN","SAMISAV",63,0)
 . . m ^SAMIUL("samisav","vals")=vars
"RTN","SAMISAV",64,0)
 . . m @root@("graph",sid,moveto)=@root@("graph",sid,form)
"RTN","SAMISAV",65,0)
 . . k @root@("graph",sid,form)
"RTN","SAMISAV",66,0)
 . . s useform=moveto
"RTN","SAMISAV",67,0)
 if type="siform" d  ; intake form
"RTN","SAMISAV",68,0)
 . s vars("samifirsttime")="false"
"RTN","SAMISAV",69,0)
 . d COMLOG(.sid,.form,.vars) ; add to the communication log
"RTN","SAMISAV",70,0)
 . n formdate s formdate=$g(vars("sidc")) ; date of the CT scan from the form
"RTN","SAMISAV",71,0)
 . q:formdate=""
"RTN","SAMISAV",72,0)
 . n fdate s fdate=$$KEY2FM^SAMICASE(formdate) ; convert to fileman date
"RTN","SAMISAV",73,0)
 . q:fdate=""
"RTN","SAMISAV",74,0)
 . q:fdate<0
"RTN","SAMISAV",75,0)
 . n fmcurrent s fmcurrent=$$KEY2FM^SAMICASE(form) ; current key in fm formate
"RTN","SAMISAV",76,0)
 . if fdate'=fmcurrent d  ;
"RTN","SAMISAV",77,0)
 . . n moveto s moveto="siform-"_$$KEYDATE^SAMIHOM3(fdate)
"RTN","SAMISAV",78,0)
 . . ;w !,"old: ",fmcurrent," new: ",fdate," ... date must be changed
"RTN","SAMISAV",79,0)
 . . k ^SAMIUL("samisav")
"RTN","SAMISAV",80,0)
 . . s ^SAMIUL("samisav","current")=form_"^"_fmcurrent
"RTN","SAMISAV",81,0)
 . . s ^SAMIUL("samisav","incoming")=formdate_"^"_fdate
"RTN","SAMISAV",82,0)
 . . s ^SAMIUL("samisav","conclusion")="graph must be moved to: "_moveto
"RTN","SAMISAV",83,0)
 . . m @root@("graph",sid,moveto)=@root@("graph",sid,form)
"RTN","SAMISAV",84,0)
 . . k @root@("graph",sid,form)
"RTN","SAMISAV",85,0)
 . . s useform=moveto
"RTN","SAMISAV",86,0)
 q useform
"RTN","SAMISAV",87,0)
 ;
"RTN","SAMISAV",88,0)
COMLOG(sid,form,vars) ; add to the communications log
"RTN","SAMISAV",89,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMISAV",90,0)
 m vars("comlog")=@root@("graph",sid,form,"comlog")
"RTN","SAMISAV",91,0)
 n COMLOGRT
"RTN","SAMISAV",92,0)
 s COMLOGRT=$na(@root@("graph",sid,form,"comlog"))
"RTN","SAMISAV",93,0)
 i $g(vars("sipcrn"))'="" d  ; a new comm log entry is available
"RTN","SAMISAV",94,0)
 . d LOGIT^SAMICLOG(COMLOGRT,vars("sipcrn"))
"RTN","SAMISAV",95,0)
 . s vars("sipcrn")=""
"RTN","SAMISAV",96,0)
 q
"RTN","SAMISAV",97,0)
 ;
"RTN","SAMISITE")
0^9^B64280616
"RTN","SAMISITE",1,0)
SAMISITE ;ven/gpl,arc - ielcap: forms;2020-03-27T17:45Z ;Mar 27, 2020@16:04
"RTN","SAMISITE",2,0)
 ;;18.0;SAMI;;;Build 12
"RTN","SAMISITE",3,0)
 ;
"RTN","SAMISITE",4,0)
 ;@license: see routine SAMIUL
"RTN","SAMISITE",5,0)
 ;
"RTN","SAMISITE",6,0)
 ; @section 0 primary development
"RTN","SAMISITE",7,0)
 ;
"RTN","SAMISITE",8,0)
 ; @routine-credits
"RTN","SAMISITE",9,0)
 ; @primary-dev: George P. Lilly (gpl)
"RTN","SAMISITE",10,0)
 ;  gpl@vistaexpertise.net
"RTN","SAMISITE",11,0)
 ; @additional-dev: Alexis Carlson (arc)
"RTN","SAMISITE",12,0)
 ;  alexis@vistaexpertise.net
"RTN","SAMISITE",13,0)
 ; @primary-dev-org: Vista Expertise Network (ven)
"RTN","SAMISITE",14,0)
 ;  http://vistaexpertise.net
"RTN","SAMISITE",15,0)
 ; @copyright: 2012/2018, ven, all rights reserved
"RTN","SAMISITE",16,0)
 ; @license: Apache 2.0
"RTN","SAMISITE",17,0)
 ;  https://www.apache.org/licenses/LICENSE-2.0.html
"RTN","SAMISITE",18,0)
 ;
"RTN","SAMISITE",19,0)
 ; @application: SAMI
"RTN","SAMISITE",20,0)
 ; @version: 18.0
"RTN","SAMISITE",21,0)
 ; @patch-list: none yet
"RTN","SAMISITE",22,0)
 ;
"RTN","SAMISITE",23,0)
 ; @to-do
"RTN","SAMISITE",24,0)
 ;   Add label comments
"RTN","SAMISITE",25,0)
 ;
"RTN","SAMISITE",26,0)
 ; @section 1 code
"RTN","SAMISITE",27,0)
 ;
"RTN","SAMISITE",28,0)
 quit  ; No entry from top
"RTN","SAMISITE",29,0)
 ;
"RTN","SAMISITE",30,0)
FINDSITE(SAMIRETURN,ARGS) ; extrinsic which returns the site
"RTN","SAMISITE",31,0)
 ; to be used by this user: ARGS("siteid")=siteid and
"RTN","SAMISITE",32,0)
 ; ARGS("sitetitle")=sitename - siteid
"RTN","SAMISITE",33,0)
 ; 1 for success 
"RTN","SAMISITE",34,0)
 ; 0 for fail - exit; page to be displayed is in SAMIRETURN
"RTN","SAMISITE",35,0)
 ;
"RTN","SAMISITE",36,0)
 ;d ^ZTER
"RTN","SAMISITE",37,0)
 n user
"RTN","SAMISITE",38,0)
 s user=$$USER()
"RTN","SAMISITE",39,0)
 i user=-1 d  q 0
"RTN","SAMISITE",40,0)
 . n vals
"RTN","SAMISITE",41,0)
 . s vals("siteid")=""
"RTN","SAMISITE",42,0)
 . s vals("sitetitle")="Unknown Site"
"RTN","SAMISITE",43,0)
 . s vals("errorMessage")=""
"RTN","SAMISITE",44,0)
 . d RTNERR^SAMIHOM4(.SAMIRETURN,"vapals:login",.vals)
"RTN","SAMISITE",45,0)
 . ;s ARGS("errorMessage")="Error, user not found"
"RTN","SAMISITE",46,0)
 . ;d RTNERR^SAMIHOM4(.SAMIRETURN,"vapals:syserror",.ARGS)
"RTN","SAMISITE",47,0)
 ;
"RTN","SAMISITE",48,0)
 ;d  q 0
"RTN","SAMISITE",49,0)
 ;. s ARGS("errorMessage")="User is found: "_user
"RTN","SAMISITE",50,0)
 ;. d RTNERR^SAMIHOM4(.SAMIRETURN,"vapals:syserror",.ARGS)
"RTN","SAMISITE",51,0)
 ;
"RTN","SAMISITE",52,0)
 n site,siteid,siteactv,sitenm
"RTN","SAMISITE",53,0)
 ;
"RTN","SAMISITE",54,0)
 i $o(^SAMI(311.13,"B",user,""))'="" d  q 0  ; superuser
"RTN","SAMISITE",55,0)
 . d SUPER("SAMIRETURN",.ARGS)
"RTN","SAMISITE",56,0)
 . s HTTPRSP("mime")="text/html"
"RTN","SAMISITE",57,0)
 ;
"RTN","SAMISITE",58,0)
 s site=$$SITE(user)
"RTN","SAMISITE",59,0)
 i site<1 s site=-1
"RTN","SAMISITE",60,0)
 i site=-1 d  q 0
"RTN","SAMISITE",61,0)
 . s ARGS("errorMessage")="Site not found for user "_user
"RTN","SAMISITE",62,0)
 . d RTNERR^SAMIHOM4(.SAMIRETURN,"vapals:syserror",.ARGS)
"RTN","SAMISITE",63,0)
 ;
"RTN","SAMISITE",64,0)
 s siteid=$$SITEID(site)
"RTN","SAMISITE",65,0)
 i siteid=-1 d  q 0
"RTN","SAMISITE",66,0)
 . s ARGS("errorMessage")="Site ID not found for site "_site
"RTN","SAMISITE",67,0)
 . d RTNERR^SAMIHOM4(.SAMIRETURN,"vapals:syserror",.ARGS)
"RTN","SAMISITE",68,0)
 ;
"RTN","SAMISITE",69,0)
 s siteactv=$$SITEACTV(site)
"RTN","SAMISITE",70,0)
 i siteactv<1 d  q 0
"RTN","SAMISITE",71,0)
 . s ARGS("errorMessage")="Site not active: "_siteid
"RTN","SAMISITE",72,0)
 . d RTNERR^SAMIHOM4(.SAMIRETURN,"vapals:syserror",.ARGS)
"RTN","SAMISITE",73,0)
 ;
"RTN","SAMISITE",74,0)
 s sitenm=$$SITENM(site)
"RTN","SAMISITE",75,0)
 i sitenm=-1 d  q 0
"RTN","SAMISITE",76,0)
 . s ARGS("errorMessage")="Site name not found: "_siteid
"RTN","SAMISITE",77,0)
 . d RTNERR^SAMIHOM4(.SAMIRETURN,"vapals:syserror",.ARGS)
"RTN","SAMISITE",78,0)
 ;
"RTN","SAMISITE",79,0)
 s ARGS("siteid")=siteid
"RTN","SAMISITE",80,0)
 s ARGS("sitetitle")=$$SITENM(site)_" - "_siteid
"RTN","SAMISITE",81,0)
 q 1
"RTN","SAMISITE",82,0)
 ;
"RTN","SAMISITE",83,0)
USER() ; extrinsic returns the DUZ of the user accessing the system
"RTN","SAMISITE",84,0)
 ; -1 means user not known
"RTN","SAMISITE",85,0)
 n rtn s rtn=-1
"RTN","SAMISITE",86,0)
 s rtn=+$G(DUZ)
"RTN","SAMISITE",87,0)
 i rtn=0 s rtn=-1
"RTN","SAMISITE",88,0)
 q rtn
"RTN","SAMISITE",89,0)
 ;
"RTN","SAMISITE",90,0)
SITE(USER) ; extrinsic returns the pointer to the Institution file
"RTN","SAMISITE",91,0)
 ; which is the site of the user
"RTN","SAMISITE",92,0)
 ; -1 means site not found
"RTN","SAMISITE",93,0)
 ; zero means site not active
"RTN","SAMISITE",94,0)
 n rtn
"RTN","SAMISITE",95,0)
 s rtn=$o(^VA(200,USER,2,0))
"RTN","SAMISITE",96,0)
 i +rtn="" s rtn=-1
"RTN","SAMISITE",97,0)
 q rtn
"RTN","SAMISITE",98,0)
 ;
"RTN","SAMISITE",99,0)
SITEID(SITE) ; extrinsic returns the Site Symbol for SITE
"RTN","SAMISITE",100,0)
 ; this is found in the SAMI SITE file
"RTN","SAMISITE",101,0)
 ; null means SITEID not found
"RTN","SAMISITE",102,0)
 n rtn s rtn=-1
"RTN","SAMISITE",103,0)
 n ien s ien=$o(^SAMI(311.12,"B",SITE,""))
"RTN","SAMISITE",104,0)
 q:ien="" -1
"RTN","SAMISITE",105,0)
 s rtn=$$GET1^DIQ(311.12,ien_",",.02)
"RTN","SAMISITE",106,0)
 q rtn
"RTN","SAMISITE",107,0)
 ; 
"RTN","SAMISITE",108,0)
SITEACTV(SITE) ; Extrinsic which returns 1 if the site is active
"RTN","SAMISITE",109,0)
 ; otherwise 0
"RTN","SAMISITE",110,0)
 n rtn s rtn=-1
"RTN","SAMISITE",111,0)
 n ien s ien=$o(^SAMI(311.12,"B",SITE,""))
"RTN","SAMISITE",112,0)
 q:ien="" -1
"RTN","SAMISITE",113,0)
 s rtn=$$GET1^DIQ(311.12,ien_",",.03,"I")
"RTN","SAMISITE",114,0)
 q rtn 
"RTN","SAMISITE",115,0)
 ;
"RTN","SAMISITE",116,0)
SITENM(SITE) ; Extrinsic which returns the Site name
"RTN","SAMISITE",117,0)
 ;
"RTN","SAMISITE",118,0)
 n rtn s rtn=-1
"RTN","SAMISITE",119,0)
 s rtn=$$GET1^DIQ(4,SITE_",",.01)
"RTN","SAMISITE",120,0)
 i rtn="" s rtn=-1
"RTN","SAMISITE",121,0)
 q rtn
"RTN","SAMISITE",122,0)
 ;
"RTN","SAMISITE",123,0)
SITENM2(SITEID) ; Extrinsic which returns the Site name from the Site Symbol
"RTN","SAMISITE",124,0)
 ;
"RTN","SAMISITE",125,0)
 q:SITEID="" -1
"RTN","SAMISITE",126,0)
 n siteien
"RTN","SAMISITE",127,0)
 s siteien=$o(^SAMI(311.12,"SYM",SITEID,""))
"RTN","SAMISITE",128,0)
 n site
"RTN","SAMISITE",129,0)
 q $$GET1^DIQ(311.12,siteien_",",.01,"E") 
"RTN","SAMISITE",130,0)
 ;
"RTN","SAMISITE",131,0)
LOGIN(RTN,VALS) ; login processing
"RTN","SAMISITE",132,0)
 ;
"RTN","SAMISITE",133,0)
 n access,verify
"RTN","SAMISITE",134,0)
 s access=$g(VALS("access"))
"RTN","SAMISITE",135,0)
 s verify=$g(VALS("verify"))
"RTN","SAMISITE",136,0)
 i access="" d  ;
"RTN","SAMISITE",137,0)
 . s access="PHXNAV1"
"RTN","SAMISITE",138,0)
 . s verify="$#happy6"
"RTN","SAMISITE",139,0)
 n ACVC s ACVC=access_";"_verify
"RTN","SAMISITE",140,0)
 i $$SIGNON(ACVC) D  Q  ;
"RTN","SAMISITE",141,0)
 . s VALS("samiroute")=""
"RTN","SAMISITE",142,0)
 . s VALS("siteid")=""
"RTN","SAMISITE",143,0)
 . d WSHOME^SAMIHOM3(.RTN,.VALS)
"RTN","SAMISITE",144,0)
 else  D  Q  ;
"RTN","SAMISITE",145,0)
 . s VALS("errorMessage")="Invalid login"
"RTN","SAMISITE",146,0)
 . d RTNERR^SAMIHOM4(.RTN,"vapals:login",.VALS)
"RTN","SAMISITE",147,0)
 q
"RTN","SAMISITE",148,0)
 ;
"RTN","SAMISITE",149,0)
SIGNON(ACVC) ; extrinsic returns 1 if signon is successful, else 0
"RTN","SAMISITE",150,0)
 ; Sign-on
"RTN","SAMISITE",151,0)
 N IO S IO=$P
"RTN","SAMISITE",152,0)
 D SETUP^XUSRB() ; Only partition set-up; No single sign-on or CAPRI
"RTN","SAMISITE",153,0)
 N RTN D VALIDAV^XUSRB(.RTN,$$ENCRYP^XUSRB1(ACVC)) ; sign-on call
"RTN","SAMISITE",154,0)
 I RTN(0)>0,'RTN(2) Q 1 ; Sign on successful!
"RTN","SAMISITE",155,0)
 I RTN(0)=0,RTN(2) Q 0  ; Verify Code must be changed NOW!
"RTN","SAMISITE",156,0)
 I $L(RTN(3)) Q 0  ; Error Message
"RTN","SAMISITE",157,0)
 ;
"RTN","SAMISITE",158,0)
 q
"RTN","SAMISITE",159,0)
 ;
"RTN","SAMISITE",160,0)
SUPER(RTN,FILTER) ; returns site selection page for super users
"RTN","SAMISITE",161,0)
 ;
"RTN","SAMISITE",162,0)
 n temp
"RTN","SAMISITE",163,0)
 d getThis^%wd("temp","blank_no_nav.html")
"RTN","SAMISITE",164,0)
 q:'$d(temp)
"RTN","SAMISITE",165,0)
 n cnt s cnt=0
"RTN","SAMISITE",166,0)
 n zj s zj=0
"RTN","SAMISITE",167,0)
 f  s zj=$o(temp(zj)) q:temp(zj)["Insert"  q:+zj=0  d  ;
"RTN","SAMISITE",168,0)
 . n ln s ln=temp(zj)
"RTN","SAMISITE",169,0)
 . i ln["PAGE NAME" s ln="Site Selection"
"RTN","SAMISITE",170,0)
 . d LOAD^SAMIFORM(.ln,"","")
"RTN","SAMISITE",171,0)
 . s cnt=cnt+1
"RTN","SAMISITE",172,0)
 . s @RTN@(cnt)=ln
"RTN","SAMISITE",173,0)
 s cnt=cnt+1
"RTN","SAMISITE",174,0)
 s @RTN@(cnt)="<ul>"
"RTN","SAMISITE",175,0)
 n gn s gn=$na(^SAMI(311.12,"B"))
"RTN","SAMISITE",176,0)
 n zi s zi=0
"RTN","SAMISITE",177,0)
 f  s zi=$o(@gn@(zi)) q:+zi=0  d  ;
"RTN","SAMISITE",178,0)
 . n zien s zien=$o(@gn@(zi,""))
"RTN","SAMISITE",179,0)
 . n active
"RTN","SAMISITE",180,0)
 . s active=$$GET1^DIQ(311.12,zien_",",.03,"I")
"RTN","SAMISITE",181,0)
 . q:active=0
"RTN","SAMISITE",182,0)
 . n name
"RTN","SAMISITE",183,0)
 . s name=$$SITENM(zi)_" - "_$$SITEID(zi)
"RTN","SAMISITE",184,0)
 . n link
"RTN","SAMISITE",185,0)
 . s link="<li>"
"RTN","SAMISITE",186,0)
 . s link=link_"<a class=""navigation"" data-method=""post"""
"RTN","SAMISITE",187,0)
 . s link=link_" data-samiroute=""home"" data-siteid="""_$$SITEID(zi)_""""
"RTN","SAMISITE",188,0)
 . ;s link=link_" data-site="""_$$SITEID(zi)_""""
"RTN","SAMISITE",189,0)
 . ;s link=link_" href=""#!"">"_$$SITENM(zi)_" - "_$$SITEID(zi)
"RTN","SAMISITE",190,0)
 . s link=link_" href=""/vapals"">"_name
"RTN","SAMISITE",191,0)
 . s link=link_"</a></li>"
"RTN","SAMISITE",192,0)
 . ;n link
"RTN","SAMISITE",193,0)
 . ;s link="<form method=POST action=""/vapals"">"
"RTN","SAMISITE",194,0)
 . ;s link=link_"<input type=hidden name=""samiroute"" value=""home"">"
"RTN","SAMISITE",195,0)
 . ;s link=link_"<input type=hidden name=""siteid"" value="""_$$SITEID(zi)_""">"
"RTN","SAMISITE",196,0)
 . ;s link=link_"<input value="""_name_""" class=""btn btn-link"" role=""link"" type=""submit""></form>"
"RTN","SAMISITE",197,0)
 . s cnt=cnt+1
"RTN","SAMISITE",198,0)
 . s @RTN@(cnt)=link
"RTN","SAMISITE",199,0)
 s cnt=cnt+1
"RTN","SAMISITE",200,0)
 s @RTN@(cnt)="</ul>"
"RTN","SAMISITE",201,0)
 n zk s zk=zj+1
"RTN","SAMISITE",202,0)
 f  s zk=$o(temp(zk)) q:+zk=0  d  ;
"RTN","SAMISITE",203,0)
 . s cnt=cnt+1
"RTN","SAMISITE",204,0)
 . s @RTN@(cnt)=temp(zk)
"RTN","SAMISITE",205,0)
 q
"RTN","SAMISITE",206,0)
 ;
"RTN","SAMISITE",207,0)
UPGRADE() ; convert VAPALS system to Multi-tenancy by adding siteid
"RTN","SAMISITE",208,0)
 ; to all existing patients - runs one time as the Post Install 
"RTN","SAMISITE",209,0)
 ; to the installation
"RTN","SAMISITE",210,0)
 ;
"RTN","SAMISITE",211,0)
 n lroot,proot,lien,pien
"RTN","SAMISITE",212,0)
 s (lien,pien)=0
"RTN","SAMISITE",213,0)
 s lroot=$$setroot^%wd("patient-lookup")
"RTN","SAMISITE",214,0)
 s proot=$$setroot^%wd("vapals-patients")
"RTN","SAMISITE",215,0)
 n site
"RTN","SAMISITE",216,0)
 s site=$$GET^XPAR("SYS","SAMI SID PREFIX",,"Q")
"RTN","SAMISITE",217,0)
 i site="" d  q  ;
"RTN","SAMISITE",218,0)
 . D MES^XPDUTL("No default site returned by SAMI SID PREFIX parameter, exiting")
"RTN","SAMISITE",219,0)
 n cnt s cnt=0
"RTN","SAMISITE",220,0)
 f  s lien=$o(@lroot@(lien)) q:+lien=0  d  ;
"RTN","SAMISITE",221,0)
 . q:$g(@lroot@(lien,"siteid"))'=""
"RTN","SAMISITE",222,0)
 . n nomatch s nomatch=0
"RTN","SAMISITE",223,0)
 . n dfn s dfn=$g(@lroot@(lien,"dfn"))
"RTN","SAMISITE",224,0)
 . i dfn="" d  q  ;
"RTN","SAMISITE",225,0)
 . . D MES^XPDUTL("Error, no dfn found for lien "_lien)
"RTN","SAMISITE",226,0)
 . s pien=$o(@proot@("dfn",dfn,""))
"RTN","SAMISITE",227,0)
 . ; make sure the first 3 chars of the studyid matches the site
"RTN","SAMISITE",228,0)
 . i pien'="" d  q:nomatch
"RTN","SAMISITE",229,0)
 . . n psite,psid
"RTN","SAMISITE",230,0)
 . . s psid=$g(@proot@(pien,"sisid"))
"RTN","SAMISITE",231,0)
 . . i psid="" s nomatch=1 q  ;
"RTN","SAMISITE",232,0)
 . . i $e(psid,1,3)'=site s nomatch=1 d  q  ;
"RTN","SAMISITE",233,0)
 . . . d MES^XPDUTL("skipping record - studyid "_psid_" does not match site "_site)
"RTN","SAMISITE",234,0)
 . ;w !,"lien "_lien_" being set to "_site
"RTN","SAMISITE",235,0)
 . s cnt=cnt+1
"RTN","SAMISITE",236,0)
 . s @lroot@(lien,"siteid")=site
"RTN","SAMISITE",237,0)
 i cnt>0 d  ;
"RTN","SAMISITE",238,0)
 . d MES^XPDUTL("Multi-tenancy upgrade successful")
"RTN","SAMISITE",239,0)
 . d MES^XPDUTL(cnt_" patient records set to site "_site)
"RTN","SAMISITE",240,0)
 q
"RTN","SAMISITE",241,0)
 ;
"RTN","SAMISRC2")
0^6^B10574823
"RTN","SAMISRC2",1,0)
SAMISRC2 ;ven/gpl - ielcap: home page search ; 2/14/19 10:49am
"RTN","SAMISRC2",2,0)
 ;;18.0;SAM;;;Build 12
"RTN","SAMISRC2",3,0)
 ;
"RTN","SAMISRC2",4,0)
 ;@license: see routine SAMIUL
"RTN","SAMISRC2",5,0)
 ;
"RTN","SAMISRC2",6,0)
 ; SAMISRCH contains subroutines for searching for patients on the
"RTN","SAMISRC2",7,0)
 ; ELCAP home page.
"RTN","SAMISRC2",8,0)
 ; It is currently untested & in progress.
"RTN","SAMISRC2",9,0)
 ;
"RTN","SAMISRC2",10,0)
 quit  ; no entry from top
"RTN","SAMISRC2",11,0)
 ;
"RTN","SAMISRC2",12,0)
 ;
"RTN","SAMISRC2",13,0)
 ;
"RTN","SAMISRC2",14,0)
 ;@section 0 primary development: see routine %wful
"RTN","SAMISRC2",15,0)
 ;
"RTN","SAMISRC2",16,0)
 ;
"RTN","SAMISRC2",17,0)
 ;
"RTN","SAMISRC2",18,0)
 ;@routine-credits
"RTN","SAMISRC2",19,0)
 ;@primary-dev: George P. Lilly (gpl)
"RTN","SAMISRC2",20,0)
 ; gpl@vistaexpertise.net
"RTN","SAMISRC2",21,0)
 ;@primary-dev-org: Vista Expertise Network (ven)
"RTN","SAMISRC2",22,0)
 ; http://vistaexpertise.net
"RTN","SAMISRC2",23,0)
 ;@copyright: 2017, gpl, all rights reserved
"RTN","SAMISRC2",24,0)
 ;@license: Apache 2.0
"RTN","SAMISRC2",25,0)
 ; https://www.apache.org/licenses/LICENSE-2.0.html
"RTN","SAMISRC2",26,0)
 ;
"RTN","SAMISRC2",27,0)
 ;@last-updated: 2018-03-07T18:49Z
"RTN","SAMISRC2",28,0)
 ;@application: Screening Applications Management (SAM)
"RTN","SAMISRC2",29,0)
 ;@module: Screening Applications Management - IELCAP (SAMI)
"RTN","SAMISRC2",30,0)
 ;@suite-of-files: SAMI Forms (311.101-311.199)
"RTN","SAMISRC2",31,0)
 ;@version: 18.0T04
"RTN","SAMISRC2",32,0)
 ;@release-date: not yet released
"RTN","SAMISRC2",33,0)
 ;@patch-list: none yet
"RTN","SAMISRC2",34,0)
 ;
"RTN","SAMISRC2",35,0)
 ;@additional-dev: Frederick D. S. Marshall (toad)
"RTN","SAMISRC2",36,0)
 ; toad@vistaexpertise.net
"RTN","SAMISRC2",37,0)
 ;
"RTN","SAMISRC2",38,0)
 ;@module-credits
"RTN","SAMISRC2",39,0)
 ;@project: VA Partnership to Increase Access to Lung Screening
"RTN","SAMISRC2",40,0)
 ; (VA-PALS)
"RTN","SAMISRC2",41,0)
 ; http://va-pals.org/
"RTN","SAMISRC2",42,0)
 ;@funding: 2017/2018, Bristol-Myers Squibb Foundation (bmsf)
"RTN","SAMISRC2",43,0)
 ; https://www.bms.com/about-us/responsibility/bristol-myers-squibb-foundation.html
"RTN","SAMISRC2",44,0)
 ;@partner-org: Veterans Affairs Office of Rural health
"RTN","SAMISRC2",45,0)
 ; https://www.ruralhealth.va.gov/
"RTN","SAMISRC2",46,0)
 ;@partner-org: International Early Lung Cancer Action Program (I-ELCAP)
"RTN","SAMISRC2",47,0)
 ; http://ielcap.com/
"RTN","SAMISRC2",48,0)
 ;@partner-org: Paraxial Technologies
"RTN","SAMISRC2",49,0)
 ; http://paraxialtech.com/
"RTN","SAMISRC2",50,0)
 ;@partner-org: Open Source Electronic Health Record Alliance (OSEHRA)
"RTN","SAMISRC2",51,0)
 ; https://www.osehra.org/groups/va-pals-open-source-project-group
"RTN","SAMISRC2",52,0)
 ;
"RTN","SAMISRC2",53,0)
 ;@module-log
"RTN","SAMISRC2",54,0)
 ; 2018-03-06 ven/gpl v18.0t04 SAMISRCH: created new routine w/web
"RTN","SAMISRC2",55,0)
 ; service subroutine WSLOOKUP.
"RTN","SAMISRC2",56,0)
 ;
"RTN","SAMISRC2",57,0)
 ; 2018-03-07 ven/toad v18.0t04 SAMISRCH: update style, spell out
"RTN","SAMISRC2",58,0)
 ; language elements, add white space & do-dot quits.
"RTN","SAMISRC2",59,0)
 ;
"RTN","SAMISRC2",60,0)
 ;@contents
"RTN","SAMISRC2",61,0)
 ;
"RTN","SAMISRC2",62,0)
 ;
"RTN","SAMISRC2",63,0)
 ;
"RTN","SAMISRC2",64,0)
 ;@section 1 web service
"RTN","SAMISRC2",65,0)
 ;
"RTN","SAMISRC2",66,0)
 ;
"RTN","SAMISRC2",67,0)
 ;
"RTN","SAMISRC2",68,0)
WSLOOKUP(ARGS,BODY,RESULT) ; look up ELCAP patient
"RTN","SAMISRC2",69,0)
 ;
"RTN","SAMISRC2",70,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMISRC2",71,0)
 ;
"RTN","SAMISRC2",72,0)
 ;ven/gpl;web service;procedure;
"RTN","SAMISRC2",73,0)
 ;@called-by
"RTN","SAMISRC2",74,0)
 ; web service SAMISRCH-WSLOOKUP
"RTN","SAMISRC2",75,0)
 ;@calls
"RTN","SAMISRC2",76,0)
 ; parseBody^%wf
"RTN","SAMISRC2",77,0)
 ; $$setroot^%wd
"RTN","SAMISRC2",78,0)
 ; $$GENSTDID^SAMIHOME
"RTN","SAMISRC2",79,0)
 ; WSCASE^SAMICASE
"RTN","SAMISRC2",80,0)
 ; GETHOME^SAMIHOME
"RTN","SAMISRC2",81,0)
 ;@input
"RTN","SAMISRC2",82,0)
 ;.ARGS =
"RTN","SAMISRC2",83,0)
 ;.BODY =
"RTN","SAMISRC2",84,0)
 ;@output
"RTN","SAMISRC2",85,0)
 ;.RESULT =
"RTN","SAMISRC2",86,0)
 ;@examples [tbd]
"RTN","SAMISRC2",87,0)
 ;@tests [tbd]
"RTN","SAMISRC2",88,0)
 ;
"RTN","SAMISRC2",89,0)
 ;@stanza 2 initialize
"RTN","SAMISRC2",90,0)
 ;
"RTN","SAMISRC2",91,0)
 merge ^SAMIUL("lookup")=ARGS
"RTN","SAMISRC2",92,0)
 merge ^SAMIUL("lookup","body")=BODY
"RTN","SAMISRC2",93,0)
 ;
"RTN","SAMISRC2",94,0)
 new vars,bdy
"RTN","SAMISRC2",95,0)
 set bdy=$get(BODY(1))
"RTN","SAMISRC2",96,0)
 do parseBody^%wf("vars",.bdy)
"RTN","SAMISRC2",97,0)
 merge ^SAMIUL("lookup","vars")=vars
"RTN","SAMISRC2",98,0)
 ;
"RTN","SAMISRC2",99,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMISRC2",100,0)
 ;
"RTN","SAMISRC2",101,0)
 new sien,trtn
"RTN","SAMISRC2",102,0)
 if $get(vars("field"))="sid" do  ; searching by studyid
"RTN","SAMISRC2",103,0)
 . set sien=$get(vars("fvalue"))
"RTN","SAMISRC2",104,0)
 . if sien="" quit  ; nothing entered to search by
"RTN","SAMISRC2",105,0)
 . if +sien=0 do  ; starts with alphabetics
"RTN","SAMISRC2",106,0)
 . . set sien=$extract(sien,4,$length(sien)) ; get rid of the prefix
"RTN","SAMISRC2",107,0)
 . . quit
"RTN","SAMISRC2",108,0)
 . set sien=+sien ; lose the leading zeros
"RTN","SAMISRC2",109,0)
 . if +sien=0 quit  ; didn't work
"RTN","SAMISRC2",110,0)
 . if $data(@root@(sien)) do  ; there is a record at that location
"RTN","SAMISRC2",111,0)
 . . set filter("studyid")=$$GENSTDID^SAMIHOM3(sien,.ARGS)
"RTN","SAMISRC2",112,0)
 . . do WSCASE^SAMICASE(.trtn,.filter)
"RTN","SAMISRC2",113,0)
 . . quit
"RTN","SAMISRC2",114,0)
 . quit
"RTN","SAMISRC2",115,0)
 ;
"RTN","SAMISRC2",116,0)
 if $data(trtn) do  quit  ; have the case review page
"RTN","SAMISRC2",117,0)
 . merge RESULT=trtn
"RTN","SAMISRC2",118,0)
 . quit
"RTN","SAMISRC2",119,0)
 ;
"RTN","SAMISRC2",120,0)
 ; on failure, resturn to the home page, maybe pass an error message
"RTN","SAMISRC2",121,0)
 ;
"RTN","SAMISRC2",122,0)
 set filter("samilookuperror")="Patient not found"
"RTN","SAMISRC2",123,0)
 do GETHOME^SAMIHOM3(.trtn,.filter)
"RTN","SAMISRC2",124,0)
 merge RESULT=trtn
"RTN","SAMISRC2",125,0)
 ;
"RTN","SAMISRC2",126,0)
 ;@stanza 3 termination
"RTN","SAMISRC2",127,0)
 ;
"RTN","SAMISRC2",128,0)
 quit  ; end of WSLOOKUP
"RTN","SAMISRC2",129,0)
 ;
"RTN","SAMISRC2",130,0)
 ;
"RTN","SAMISRC2",131,0)
 ;
"RTN","SAMISRC2",132,0)
EOR ; end of routine SAMISRCH
"RTN","SAMIUR")
0^11^B110568961
"RTN","SAMIUR",1,0)
SAMIUR ;ven/gpl - sami user reports ; 4/23/19 10:43am
"RTN","SAMIUR",2,0)
 ;;18.0;SAM;;;Build 12
"RTN","SAMIUR",3,0)
 ;
"RTN","SAMIUR",4,0)
 ;@license: see routine SAMIUL
"RTN","SAMIUR",5,0)
 ;
"RTN","SAMIUR",6,0)
 ; SAMIUR contains the routines to generate user reports
"RTN","SAMIUR",7,0)
 ; It is currently untested & in progress.
"RTN","SAMIUR",8,0)
 ;
"RTN","SAMIUR",9,0)
 quit  ; no entry from top
"RTN","SAMIUR",10,0)
 ;
"RTN","SAMIUR",11,0)
WSREPORT(SAMIRTN,filter) ; generate a report based on parameters in the filter
"RTN","SAMIUR",12,0)
 ;
"RTN","SAMIUR",13,0)
 ; here are the user reports that are defined:
"RTN","SAMIUR",14,0)
 ;  1. followup
"RTN","SAMIUR",15,0)
 ;  2. activity
"RTN","SAMIUR",16,0)
 ;  3. missingct
"RTN","SAMIUR",17,0)
 ;  4. incomplete
"RTN","SAMIUR",18,0)
 ;  5. outreach
"RTN","SAMIUR",19,0)
 ;  6. enrollment
"RTN","SAMIUR",20,0)
 ;  7. worklist
"RTN","SAMIUR",21,0)
 ; the report to generate is passed in parameter samireporttype
"RTN","SAMIUR",22,0)
 ;
"RTN","SAMIUR",23,0)
 n debug s debug=0
"RTN","SAMIUR",24,0)
 i $g(filter("debug"))=1 s debug=1
"RTN","SAMIUR",25,0)
 i $g(filter("debug"))=1 s debug=1
"RTN","SAMIUR",26,0)
 k SAMIRTN
"RTN","SAMIUR",27,0)
 s HTTPRSP("mime")="text/html"
"RTN","SAMIUR",28,0)
 ;
"RTN","SAMIUR",29,0)
 n type,temp
"RTN","SAMIUR",30,0)
 s type=$g(filter("samireporttype"))
"RTN","SAMIUR",31,0)
 i type="" d  q  ; report type missing
"RTN","SAMIUR",32,0)
 . d GETHOME^SAMIHOM3(.SAMIRTN,.filter) ; send them to home
"RTN","SAMIUR",33,0)
 ;
"RTN","SAMIUR",34,0)
 d getThis^%wd("temp","table.html") ; page template
"RTN","SAMIUR",35,0)
 q:'$d(temp)
"RTN","SAMIUR",36,0)
 ;
"RTN","SAMIUR",37,0)
 n SAMIPATS
"RTN","SAMIUR",38,0)
 ;s pats=""
"RTN","SAMIUR",39,0)
 n datephrase
"RTN","SAMIUR",40,0)
 d SELECT(.SAMIPATS,type,.datephrase,.filter) ; select patients for the report
"RTN","SAMIUR",41,0)
 ;q:'$d(SAMIPATS)
"RTN","SAMIUR",42,0)
 ;
"RTN","SAMIUR",43,0)
 n ln,cnt,ii
"RTN","SAMIUR",44,0)
 s (ii,ln,cnt)=0
"RTN","SAMIUR",45,0)
 f  s ii=$o(temp(ii)) q:+ii=0  q:$g(temp(ii))["<thead"  d  ;
"RTN","SAMIUR",46,0)
 . s cnt=cnt+1
"RTN","SAMIUR",47,0)
 . s ln=$g(temp(ii))
"RTN","SAMIUR",48,0)
 . n samikey,si
"RTN","SAMIUR",49,0)
 . s (samikey,si)=""
"RTN","SAMIUR",50,0)
 . d LOAD^SAMIFORM(.ln,samikey,si,.filter)
"RTN","SAMIUR",51,0)
 . ;i ln["PAGE NAME" d findReplace^%ts(.ln,"PAGE NAME",$$PNAME(type,datephrase))
"RTN","SAMIUR",52,0)
 . i ln["PAGE NAME" d findReplace^%ts(.ln,"PAGE NAME",$$PNAME(type,""))
"RTN","SAMIUR",53,0)
 . i ln["CRITERIA" d findReplace^%ts(.ln,"CRITERIA",datephrase)
"RTN","SAMIUR",54,0)
 . i ln["@@REPORTTYPE@@" d findReplace^%ts(.ln,"@@REPORTTYPE@@",type)
"RTN","SAMIUR",55,0)
 . ;
"RTN","SAMIUR",56,0)
 . i ln["name=""start-date""" d findReplace^%ts(.ln,"start-date""","start-date"" value="""_$g(filter("start-date"))_"""")
"RTN","SAMIUR",57,0)
 . i ln["name=""end-date""" d findReplace^%ts(.ln,"end-date""","end-date"" value="""_$g(filter("end-date"))_"""")
"RTN","SAMIUR",58,0)
 . s SAMIRTN(cnt)=ln
"RTN","SAMIUR",59,0)
 . ;
"RTN","SAMIUR",60,0)
 n RPT,ik
"RTN","SAMIUR",61,0)
 d RPTTBL^SAMIUR2(.RPT,type) ; get the report specs
"RTN","SAMIUR",62,0)
 i '$d(RPT) d  q  ; don't know about this report
"RTN","SAMIUR",63,0)
 . d GETHOME^SAMIHOM3(.SAMIRTN,.filter) ; send them to home
"RTN","SAMIUR",64,0)
 ;
"RTN","SAMIUR",65,0)
 ; output the header
"RTN","SAMIUR",66,0)
 ;
"RTN","SAMIUR",67,0)
 s cnt=cnt+1 s SAMIRTN(cnt)="<thead><tr>"
"RTN","SAMIUR",68,0)
 s ir=""
"RTN","SAMIUR",69,0)
 f  s ir=$o(RPT(ir)) q:ir=""  d  ;
"RTN","SAMIUR",70,0)
 . s cnt=cnt+1
"RTN","SAMIUR",71,0)
 . s SAMIRTN(cnt)="<th>"_$g(RPT(ir,"header"))_"</th>"
"RTN","SAMIUR",72,0)
 s cnt=cnt+1 s SAMIRTN(cnt)="</tr></thead>"
"RTN","SAMIUR",73,0)
 ;
"RTN","SAMIUR",74,0)
 s cnt=cnt+1 s SAMIRTN(cnt)="<tbody>"
"RTN","SAMIUR",75,0)
 ;
"RTN","SAMIUR",76,0)
 i type'="worklist" d  ; 
"RTN","SAMIUR",77,0)
 . d NUHREF(.SAMIPATS) ; create the nuhref link for all patients
"RTN","SAMIUR",78,0)
 ;
"RTN","SAMIUR",79,0)
 s ij=0
"RTN","SAMIUR",80,0)
 f  s ij=$o(SAMIPATS(ij)) q:+ij=0  d  ;
"RTN","SAMIUR",81,0)
 . n ij2 s ij2=0
"RTN","SAMIUR",82,0)
 . f  s ij2=$o(SAMIPATS(ij,ij2)) q:+ij2=0  d  ;
"RTN","SAMIUR",83,0)
 . . n dfn s dfn=ij2
"RTN","SAMIUR",84,0)
 . . s cnt=cnt+1 s SAMIRTN(cnt)="<tr>"
"RTN","SAMIUR",85,0)
 . . s ir=""
"RTN","SAMIUR",86,0)
 . . f  s ir=$o(RPT(ir)) q:ir=""  d  ;
"RTN","SAMIUR",87,0)
 . . . s cnt=cnt+1
"RTN","SAMIUR",88,0)
 . . . n XR,XRV
"RTN","SAMIUR",89,0)
 . . . ;s XR=$g(RPT(ir,"routine"))_"("_ij_",.SAMIPATS)"
"RTN","SAMIUR",90,0)
 . . . s XR="S XRV="_$g(RPT(ir,"routine"))_"("_ij_","_dfn_",.SAMIPATS)"
"RTN","SAMIUR",91,0)
 . . . ;s XRV=@XR
"RTN","SAMIUR",92,0)
 . . . X XR
"RTN","SAMIUR",93,0)
 . . . s SAMIRTN(cnt)="<td>"_$g(XRV)_"</td>"
"RTN","SAMIUR",94,0)
 . . ;
"RTN","SAMIUR",95,0)
 . . s cnt=cnt+1
"RTN","SAMIUR",96,0)
 . . s SAMIRTN(cnt)="</tr>"
"RTN","SAMIUR",97,0)
 ;
"RTN","SAMIUR",98,0)
 s cnt=cnt+1 s SAMIRTN(cnt)="</tbody>"
"RTN","SAMIUR",99,0)
 f  s ii=$o(temp(ii)) q:temp(ii)["</tbody>"  d  ;
"RTN","SAMIUR",100,0)
 . ; skip past template headers and blank body
"RTN","SAMIUR",101,0)
 f  s ii=$o(temp(ii)) q:+ii=0  d  ;
"RTN","SAMIUR",102,0)
 . s cnt=cnt+1
"RTN","SAMIUR",103,0)
 . s ln=$g(temp(ii))
"RTN","SAMIUR",104,0)
 . n samikey,si
"RTN","SAMIUR",105,0)
 . s (samikey,si)=""
"RTN","SAMIUR",106,0)
 . d LOAD^SAMIFORM(.ln,samikey,si,.filter)
"RTN","SAMIUR",107,0)
 . s SAMIRTN(cnt)=ln
"RTN","SAMIUR",108,0)
 q
"RTN","SAMIUR",109,0)
 ;
"RTN","SAMIUR",110,0)
NUHREF(SAMIPATS) ; create the nuhref link to casereview for all patients
"RTN","SAMIUR",111,0)
 n ij
"RTN","SAMIUR",112,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIUR",113,0)
 s ij=0
"RTN","SAMIUR",114,0)
 f  s ij=$o(SAMIPATS(ij)) q:+ij=0  d  ;
"RTN","SAMIUR",115,0)
 . n ij2 s ij2=0
"RTN","SAMIUR",116,0)
 . f  s ij2=$o(SAMIPATS(ij,ij2)) q:+ij2=0  d  ;
"RTN","SAMIUR",117,0)
 . . n dfn s dfn=ij2
"RTN","SAMIUR",118,0)
 . . s SAMIPATS(ij,dfn,"sid")=$g(@root@(dfn,"samistudyid"))
"RTN","SAMIUR",119,0)
 . . n sid s sid=SAMIPATS(ij,dfn,"sid")
"RTN","SAMIUR",120,0)
 . . s SAMIPATS(ij,dfn,"name")=$g(@root@(dfn,"saminame"))
"RTN","SAMIUR",121,0)
 . . n name s name=SAMIPATS(ij,dfn,"name")
"RTN","SAMIUR",122,0)
 . . s SAMIPATS(ij,dfn,"ssn")=$$GETSSN^SAMIFORM(sid)
"RTN","SAMIUR",123,0)
 . . new nuhref set nuhref="<form method=POST action=""/vapals"">"
"RTN","SAMIUR",124,0)
 . . set nuhref=nuhref_"<input type=hidden name=""samiroute"" value=""casereview"">"
"RTN","SAMIUR",125,0)
 . . set nuhref=nuhref_"<input type=hidden name=""studyid"" value="_sid_">"
"RTN","SAMIUR",126,0)
 . . set nuhref=nuhref_"<input value="""_name_""" class=""btn btn-link"" role=""link"" type=""submit""></form>"
"RTN","SAMIUR",127,0)
 . . s SAMIPATS(ij,dfn,"nuhref")=nuhref
"RTN","SAMIUR",128,0)
 q
"RTN","SAMIUR",129,0)
 ;
"RTN","SAMIUR",130,0)
SELECT(SAMIPATS,ztype,datephrase,filter) ;selects patients for report
"RTN","SAMIUR",131,0)
 ;m ^gpl("select")=filter
"RTN","SAMIUR",132,0)
 n type s type=ztype
"RTN","SAMIUR",133,0)
 i type="unmatched" d  q  ;
"RTN","SAMIUR",134,0)
 . d UNMAT(.SAMIPATS,ztype,.datephrase,.filter)
"RTN","SAMIUR",135,0)
 i type="worklist" d  q  ;
"RTN","SAMIUR",136,0)
 . d WKLIST(.SAMIPATS,ztype,.datephrase,.filter)
"RTN","SAMIUR",137,0)
 i $g(type)="" s type="enrollment"
"RTN","SAMIUR",138,0)
 i type="cumpy" s type="enrollment"
"RTN","SAMIUR",139,0)
 n site s site=$g(filter("siteid"))
"RTN","SAMIUR",140,0)
 n strdt,enddt,fmstrdt,fmenddt
"RTN","SAMIUR",141,0)
 s strdt=$g(filter("start-date"))
"RTN","SAMIUR",142,0)
 s fmstrdt=$$KEY2FM^SAMICASE(strdt)
"RTN","SAMIUR",143,0)
 i fmstrdt=-1 d  ;
"RTN","SAMIUR",144,0)
 . s fmstrdt=2000101
"RTN","SAMIUR",145,0)
 . i type="followup" s fmstrdt=$$NOW^XLFDT
"RTN","SAMIUR",146,0)
 . i type="activity" s fmstrdt=$$FMADD^XLFDT($$NOW^XLFDT,-31)
"RTN","SAMIUR",147,0)
 i strdt="" s filter("start-date")=$$VAPALSDT^SAMICASE(fmstrdt)
"RTN","SAMIUR",148,0)
 s enddt=$g(filter("end-date"))
"RTN","SAMIUR",149,0)
 s fmenddt=$$KEY2FM^SAMICASE(enddt)
"RTN","SAMIUR",150,0)
 i fmenddt=-1 d  ;
"RTN","SAMIUR",151,0)
 . s fmenddt=$$NOW^XLFDT
"RTN","SAMIUR",152,0)
 . i type="followup" s fmenddt=$$FMADD^XLFDT($$NOW^XLFDT,31)
"RTN","SAMIUR",153,0)
 i enddt="" s filter("end-date")=$$VAPALSDT^SAMICASE(fmenddt)
"RTN","SAMIUR",154,0)
 s datephrase=""
"RTN","SAMIUR",155,0)
 n zi s zi=0
"RTN","SAMIUR",156,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIUR",157,0)
 ;
"RTN","SAMIUR",158,0)
 f  s zi=$o(@root@(zi)) q:+zi=0  d  ;
"RTN","SAMIUR",159,0)
 . n sid s sid=$g(@root@(zi,"samistudyid"))
"RTN","SAMIUR",160,0)
 . q:sid=""
"RTN","SAMIUR",161,0)
 . q:$e(sid,1,3)'=site
"RTN","SAMIUR",162,0)
 . n items s items=""
"RTN","SAMIUR",163,0)
 . d GETITEMS^SAMICASE("items",sid)
"RTN","SAMIUR",164,0)
 . q:'$d(items)
"RTN","SAMIUR",165,0)
 . n efmdate,edate,siform,ceform,cefud,fmcefud,cedos,fmcedos
"RTN","SAMIUR",166,0)
 . s siform=$o(items("siform-"))
"RTN","SAMIUR",167,0)
 . i $g(@root@("graph",sid,siform,"sistatus"))="inactive" q  ;
"RTN","SAMIUR",168,0)
 . s ceform=$o(items("ceform-a"),-1)
"RTN","SAMIUR",169,0)
 . s (cefud,fmcefud,cedos,fmcedos)=""
"RTN","SAMIUR",170,0)
 . i ceform'="" d  ;
"RTN","SAMIUR",171,0)
 . . s cefud=$g(@root@("graph",sid,ceform,"cefud"))
"RTN","SAMIUR",172,0)
 . . i cefud'="" s fmcefud=$$KEY2FM^SAMICASE(cefud)
"RTN","SAMIUR",173,0)
 . . s cedos=$g(@root@("graph",sid,ceform,"cedos"))
"RTN","SAMIUR",174,0)
 . . i cedos'="" s fmcedos=$$KEY2FM^SAMICASE(cedos)
"RTN","SAMIUR",175,0)
 . s edate=$g(@root@("graph",sid,siform,"sidc"))
"RTN","SAMIUR",176,0)
 . i edate="" s edate=$g(@root@("graph",sid,siform,"samicreatedate"))
"RTN","SAMIUR",177,0)
 . s efmdate=$$KEY2FM^SAMICASE(edate)
"RTN","SAMIUR",178,0)
 . s edate=$$VAPALSDT^SAMICASE(efmdate)
"RTN","SAMIUR",179,0)
 . ;
"RTN","SAMIUR",180,0)
 . i type="followup" d  ;
"RTN","SAMIUR",181,0)
 . . ;n nplus30 s nplus30=$$FMADD^XLFDT($$NOW^XLFDT,31)
"RTN","SAMIUR",182,0)
 . . i +fmcefud<fmstrdt q  ; before start date
"RTN","SAMIUR",183,0)
 . . i (+fmcefud<(fmenddt+1)) d  ; before end date
"RTN","SAMIUR",184,0)
 . . . i ceform="" q  ; no ct eval so no followup date
"RTN","SAMIUR",185,0)
 . . . s SAMIPATS(fmcefud,zi,"edate")=edate
"RTN","SAMIUR",186,0)
 . . . s SAMIPATS(fmcefud,zi)=""
"RTN","SAMIUR",187,0)
 . . . i ceform="" s cefud="baseline"
"RTN","SAMIUR",188,0)
 . . . s SAMIPATS(fmcefud,zi,"cefud")=cefud
"RTN","SAMIUR",189,0)
 . . . s SAMIPATS(fmcefud,zi,"cedos")=cedos
"RTN","SAMIUR",190,0)
 . . . s SAMIPATS(fmcefud,zi,"ceform")=ceform
"RTN","SAMIUR",191,0)
 . . . s SAMIPATS(fmcefud,zi,"ceform-vals")=$na(@root@("graph",sid,ceform))
"RTN","SAMIUR",192,0)
 . . . s SAMIPATS(fmcefud,zi,"siform")=siform
"RTN","SAMIUR",193,0)
 . . . s SAMIPATS(fmcefud,zi,"siform-vals")=$na(@root@("graph",sid,siform))
"RTN","SAMIUR",194,0)
 . . . m SAMIPATS(fmcefud,zi,"items")=items
"RTN","SAMIUR",195,0)
 . . s datephrase=" before "_$$VAPALSDT^SAMICASE(fmenddt)
"RTN","SAMIUR",196,0)
 . . q
"RTN","SAMIUR",197,0)
 . i type="activity" d  ;
"RTN","SAMIUR",198,0)
 . . ;n nminus30 s nminus30=$$FMADD^XLFDT($$NOW^XLFDT,-31)
"RTN","SAMIUR",199,0)
 . . n anyform s anyform=$o(items("sort",""),-1)
"RTN","SAMIUR",200,0)
 . . n fmanyform s fmanyform=$$KEY2FM^SAMICASE(anyform)
"RTN","SAMIUR",201,0)
 . . i +fmanyform<fmstrdt q  ; before the start date
"RTN","SAMIUR",202,0)
 . . ;i (+fmanyform<(fmenddt+1))!(+efmdate>fmenddt) d  ; need any new form
"RTN","SAMIUR",203,0)
 . . i (+fmanyform<(fmenddt+1))  d  ;
"RTN","SAMIUR",204,0)
 . . . s SAMIPATS(efmdate,zi,"edate")=edate
"RTN","SAMIUR",205,0)
 . . . s SAMIPATS(efmdate,zi)=""
"RTN","SAMIUR",206,0)
 . . . i ceform="" s cefud="baseline"
"RTN","SAMIUR",207,0)
 . . . s SAMIPATS(efmdate,zi,"cefud")=cefud
"RTN","SAMIUR",208,0)
 . . . s SAMIPATS(efmdate,zi,"cedos")=cedos
"RTN","SAMIUR",209,0)
 . . . s SAMIPATS(efmdate,zi,"ceform")=ceform
"RTN","SAMIUR",210,0)
 . . . s SAMIPATS(efmdate,zi,"siform")=siform
"RTN","SAMIUR",211,0)
 . . . m SAMIPATS(efmdate,zi,"items")=items
"RTN","SAMIUR",212,0)
 . . s datephrase=" after "_$$VAPALSDT^SAMICASE(fmstrdt)
"RTN","SAMIUR",213,0)
 . ;
"RTN","SAMIUR",214,0)
 . ; date filter for all the rest of the reports
"RTN","SAMIUR",215,0)
 . ;
"RTN","SAMIUR",216,0)
 . i efmdate<fmstrdt q  ; before the start date
"RTN","SAMIUR",217,0)
 . i efmdate>(fmenddt+1) q  ; after the end date
"RTN","SAMIUR",218,0)
 . ;
"RTN","SAMIUR",219,0)
 . i type="incomplete" d  ;
"RTN","SAMIUR",220,0)
 . . n complete s complete=1
"RTN","SAMIUR",221,0)
 . . n zj s zj=""
"RTN","SAMIUR",222,0)
 . . n gr s gr=$na(@root@("graph",sid))
"RTN","SAMIUR",223,0)
 . . f  s zj=$o(@gr@(zj)) q:zj=""  d  ;
"RTN","SAMIUR",224,0)
 . . . i $g(@gr@(zj,"samistatus"))="incomplete" d  ;
"RTN","SAMIUR",225,0)
 . . . . s complete=0
"RTN","SAMIUR",226,0)
 . . . . s SAMIPATS(efmdate,zi,"iform")=$g(SAMIPATS(efmdate,zi,"iform"))_" "_zj
"RTN","SAMIUR",227,0)
 . . i complete=0 d  ; has incomplete form(s) 
"RTN","SAMIUR",228,0)
 . . . s SAMIPATS(efmdate,zi,"edate")=edate
"RTN","SAMIUR",229,0)
 . . . s SAMIPATS(efmdate,zi)=""
"RTN","SAMIUR",230,0)
 . . . i ceform="" s cefud="baseline"
"RTN","SAMIUR",231,0)
 . . . s SAMIPATS(efmdate,zi,"cefud")=cefud
"RTN","SAMIUR",232,0)
 . . . s SAMIPATS(efmdate,zi,"ceform")=ceform
"RTN","SAMIUR",233,0)
 . . . s SAMIPATS(efmdate,zi,"siform")=siform
"RTN","SAMIUR",234,0)
 . . . m SAMIPATS(efmdate,zi,"items")=items
"RTN","SAMIUR",235,0)
 . . s datephrase=""
"RTN","SAMIUR",236,0)
 . . q
"RTN","SAMIUR",237,0)
 . i type="missingct" d  ;
"RTN","SAMIUR",238,0)
 . . i ceform="" d  ; has incomplete form(s) 
"RTN","SAMIUR",239,0)
 . . . s SAMIPATS(efmdate,zi,"edate")=edate
"RTN","SAMIUR",240,0)
 . . . s SAMIPATS(efmdate,zi)=""
"RTN","SAMIUR",241,0)
 . . . i ceform="" s cefud="baseline"
"RTN","SAMIUR",242,0)
 . . . s SAMIPATS(efmdate,zi,"cefud")=cefud
"RTN","SAMIUR",243,0)
 . . . s SAMIPATS(efmdate,zi,"ceform")=ceform
"RTN","SAMIUR",244,0)
 . . . s SAMIPATS(efmdate,zi,"siform")=siform
"RTN","SAMIUR",245,0)
 . . . m SAMIPATS(efmdate,zi,"items")=items
"RTN","SAMIUR",246,0)
 . . s datephrase=""
"RTN","SAMIUR",247,0)
 . . q
"RTN","SAMIUR",248,0)
 . i type="outreach" d  ;
"RTN","SAMIUR",249,0)
 . . q
"RTN","SAMIUR",250,0)
 . i type="enrollment" d  ;
"RTN","SAMIUR",251,0)
 . . s SAMIPATS(efmdate,zi,"edate")=edate
"RTN","SAMIUR",252,0)
 . . s SAMIPATS(efmdate,zi)=""
"RTN","SAMIUR",253,0)
 . . s SAMIPATS(efmdate,zi,"cefud")=cefud
"RTN","SAMIUR",254,0)
 . . s SAMIPATS(efmdate,zi,"ceform")=ceform
"RTN","SAMIUR",255,0)
 . . s SAMIPATS(efmdate,zi,"cedos")=cedos
"RTN","SAMIUR",256,0)
 . . s SAMIPATS(efmdate,zi,"siform")=siform
"RTN","SAMIUR",257,0)
 . . m SAMIPATS(efmdate,zi,"items")=items
"RTN","SAMIUR",258,0)
 . s datephrase=" as of "_$$VAPALSDT^SAMICASE($$NOW^XLFDT)
"RTN","SAMIUR",259,0)
 q
"RTN","SAMIUR",260,0)
 ;
"RTN","SAMIUR",261,0)
UNMAT(SAMIPATS,ztype,datephrase,filter)
"RTN","SAMIUR",262,0)
 ;
"RTN","SAMIUR",263,0)
 s datephrase="Unmatched Persons"
"RTN","SAMIUR",264,0)
 n lroot s lroot=$$setroot^%wd("patient-lookup")
"RTN","SAMIUR",265,0)
 n dfn s dfn=9000000
"RTN","SAMIUR",266,0)
 f  s dfn=$o(@lroot@("dfn",dfn)) q:+dfn=0  d  ;
"RTN","SAMIUR",267,0)
 . n ien s ien=$o(@lroot@("dfn",dfn,""))
"RTN","SAMIUR",268,0)
 . q:ien=""
"RTN","SAMIUR",269,0)
 . i $g(@lroot@(ien,"remotedfn"))'="" q  ;
"RTN","SAMIUR",270,0)
 . m SAMIPATS(ien,dfn)=@lroot@(ien)
"RTN","SAMIUR",271,0)
 . ;new name set name=$g(SAMIPATS(ien,dfn,"saminame"))
"RTN","SAMIUR",272,0)
 . new name set name=$g(SAMIPATS(ien,dfn,"sinamef"))
"RTN","SAMIUR",273,0)
 . set name=name_","_SAMIPATS(ien,dfn,"sinamel")
"RTN","SAMIUR",274,0)
 . new nuhref set nuhref="<form method=POST action=""/vapals"">"
"RTN","SAMIUR",275,0)
 . set nuhref=nuhref_"<input type=hidden name=""samiroute"" value=""editperson"">"
"RTN","SAMIUR",276,0)
 . set nuhref=nuhref_"<input type=hidden name=""dfn"" value="_dfn_">"
"RTN","SAMIUR",277,0)
 . set nuhref=nuhref_"<input value="""_name_""" class=""btn btn-link"" role=""link"" type=""submit""></form>"
"RTN","SAMIUR",278,0)
 . s SAMIPATS(ien,dfn,"editref")=nuhref
"RTN","SAMIUR",279,0)
 q
"RTN","SAMIUR",280,0)
 ;
"RTN","SAMIUR",281,0)
WKLIST(SAMIPATS,ztype,datephrase,filter)
"RTN","SAMIUR",282,0)
 ;
"RTN","SAMIUR",283,0)
 ; add site
"RTN","SAMIUR",284,0)
 ; add compare to vapals-patients
"RTN","SAMIUR",285,0)
 ; add navigation to enrollment
"RTN","SAMIUR",286,0)
 ;
"RTN","SAMIUR",287,0)
 k ^gpl("worklist")
"RTN","SAMIUR",288,0)
 m ^gpl("worklist")=filter
"RTN","SAMIUR",289,0)
 n site
"RTN","SAMIUR",290,0)
 s site=$g(filter("siteid"))
"RTN","SAMIUR",291,0)
 q:site=""
"RTN","SAMIUR",292,0)
 s datephrase="Work List"
"RTN","SAMIUR",293,0)
 n lroot s lroot=$$setroot^%wd("patient-lookup")
"RTN","SAMIUR",294,0)
 n proot s proot=$$setroot^%wd("vapals-patients")
"RTN","SAMIUR",295,0)
 n dfn s dfn=0
"RTN","SAMIUR",296,0)
 f  s dfn=$o(@lroot@("dfn",dfn)) q:+dfn=0  d  ;
"RTN","SAMIUR",297,0)
 . q:$o(@proot@("dfn",dfn,""))'=""
"RTN","SAMIUR",298,0)
 . n ien s ien=$o(@lroot@("dfn",dfn,""))
"RTN","SAMIUR",299,0)
 . q:ien=""
"RTN","SAMIUR",300,0)
 . q:$g(@lroot@(ien,"siteid"))'=site
"RTN","SAMIUR",301,0)
 . m ^gpl("worklist","lroot",ien)=@lroot@(ien)
"RTN","SAMIUR",302,0)
 . m SAMIPATS(ien,dfn)=@lroot@(ien)
"RTN","SAMIUR",303,0)
 . new name set name=$g(SAMIPATS(ien,dfn,"saminame"))
"RTN","SAMIUR",304,0)
 . ;new name set name=$g(SAMIPATS(ien,dfn,"sinamef"))
"RTN","SAMIUR",305,0)
 . ;set name=name_","_SAMIPATS(ien,dfn,"sinamel")
"RTN","SAMIUR",306,0)
 . new nuhref set nuhref="<form method=POST action=""/vapals"">"
"RTN","SAMIUR",307,0)
 . set nuhref=nuhref_"<input type=hidden name=""samiroute"" value=""newcase"">"
"RTN","SAMIUR",308,0)
 . set nuhref=nuhref_"<input type=hidden name=""dfn"" value="_dfn_">"
"RTN","SAMIUR",309,0)
 . set nuhref=nuhref_"<input type=hidden name=""siteid"" value="_site_">"
"RTN","SAMIUR",310,0)
 . set nuhref=nuhref_"<input value="""_name_""" class=""btn btn-link"" role=""link"" type=""submit""></form>"
"RTN","SAMIUR",311,0)
 . s SAMIPATS(ien,dfn,"workref")=nuhref
"RTN","SAMIUR",312,0)
 m ^gpl("worklist","pats")=SAMIPATS
"RTN","SAMIUR",313,0)
 q
"RTN","SAMIUR",314,0)
 ;
"RTN","SAMIUR",315,0)
PNAME(type,phrase) ; extrinsic returns the PAGE NAME for the report
"RTN","SAMIUR",316,0)
 ;i type="followup" q "Followup next 30 days -"_$g(phrase)
"RTN","SAMIUR",317,0)
 i type="followup" q "Followup "_$g(phrase)
"RTN","SAMIUR",318,0)
 ;i type="activity" q "Activity last 30 days -"_$g(phrase)
"RTN","SAMIUR",319,0)
 i type="activity" q "Activity "_$g(phrase)
"RTN","SAMIUR",320,0)
 i type="missingct" q "Intake but no CT Evaluation"_$g(phrase)
"RTN","SAMIUR",321,0)
 i type="incomplete" q "Incomplete Forms"_$g(phrase)
"RTN","SAMIUR",322,0)
 i type="outreach" q "Outreach"_$g(phrase)
"RTN","SAMIUR",323,0)
 i type="enrollment" q "Enrollment"_$g(phrase)
"RTN","SAMIUR",324,0)
 q ""
"RTN","SAMIUR",325,0)
 ;
"RTN","SAMIUR1")
0^12^B58855507
"RTN","SAMIUR1",1,0)
SAMIUR1 ;ven/gpl - sami user reports ; 4/23/19 10:07am
"RTN","SAMIUR1",2,0)
 ;;18.0;SAM;;;Build 12
"RTN","SAMIUR1",3,0)
 ;
"RTN","SAMIUR1",4,0)
 ;@license: see routine SAMIUL
"RTN","SAMIUR1",5,0)
 ;
"RTN","SAMIUR1",6,0)
 ; SAMIUR contains the routines to generate user reports
"RTN","SAMIUR1",7,0)
 ; It is currently untested & in progress.
"RTN","SAMIUR1",8,0)
 ;
"RTN","SAMIUR1",9,0)
 quit  ; no entry from top
"RTN","SAMIUR1",10,0)
 ;
"RTN","SAMIUR1",11,0)
WSREPORT(SAMIRTN,filter) ; generate a report based on parameters in the filter
"RTN","SAMIUR1",12,0)
 ;
"RTN","SAMIUR1",13,0)
 ; here are the user reports that are defined:
"RTN","SAMIUR1",14,0)
 ;  1. followup
"RTN","SAMIUR1",15,0)
 ;  2. activity
"RTN","SAMIUR1",16,0)
 ;  3. missingct
"RTN","SAMIUR1",17,0)
 ;  4. incomplete
"RTN","SAMIUR1",18,0)
 ;  5. outreach
"RTN","SAMIUR1",19,0)
 ;  6. enrollment
"RTN","SAMIUR1",20,0)
 ; the report to generate is passed in parameter samireporttype
"RTN","SAMIUR1",21,0)
 ;
"RTN","SAMIUR1",22,0)
 n type,temp
"RTN","SAMIUR1",23,0)
 s type=$g(filter("samireporttype"))
"RTN","SAMIUR1",24,0)
 i type="" d  q  ; report type missing
"RTN","SAMIUR1",25,0)
 . d GETHOME^SAMIHOM3(.SAMIRTN,.filter) ; send them to home
"RTN","SAMIUR1",26,0)
 ;
"RTN","SAMIUR1",27,0)
 n RPT2
"RTN","SAMIUR1",28,0)
 d RPTTBL^SAMIUR2(.RPT2,type)
"RTN","SAMIUR1",29,0)
 i $d(RPT2) d  q  ;
"RTN","SAMIUR1",30,0)
 . d WSREPORT^SAMIUR(.SAMIRTN,.filter)
"RTN","SAMIUR1",31,0)
 n debug s debug=0
"RTN","SAMIUR1",32,0)
 i $g(filter("debug"))=1 s debug=1
"RTN","SAMIUR1",33,0)
 i $g(filter("debug"))=1 s debug=1
"RTN","SAMIUR1",34,0)
 k return
"RTN","SAMIUR1",35,0)
 s HTTPRSP("mime")="text/html"
"RTN","SAMIUR1",36,0)
 ;
"RTN","SAMIUR1",37,0)
 d getThis^%wd("temp","table.html") ; page template
"RTN","SAMIUR1",38,0)
 q:'$d(temp)
"RTN","SAMIUR1",39,0)
 ;
"RTN","SAMIUR1",40,0)
 n pats
"RTN","SAMIUR1",41,0)
 s pats=""
"RTN","SAMIUR1",42,0)
 n datephrase
"RTN","SAMIUR1",43,0)
 d SELECT(.pats,type,.datephrase) ; select patients for the report
"RTN","SAMIUR1",44,0)
 q:'$d(pats)
"RTN","SAMIUR1",45,0)
 ;
"RTN","SAMIUR1",46,0)
 n ln,cnt,ii
"RTN","SAMIUR1",47,0)
 s (ii,ln,cnt)=0
"RTN","SAMIUR1",48,0)
 f  s ii=$o(temp(ii)) q:+ii=0  q:$g(temp(ii))["<thead"  d  ;
"RTN","SAMIUR1",49,0)
 . s cnt=cnt+1
"RTN","SAMIUR1",50,0)
 . s ln=$g(temp(ii))
"RTN","SAMIUR1",51,0)
 . n samikey,si
"RTN","SAMIUR1",52,0)
 . s (samikey,si)=""
"RTN","SAMIUR1",53,0)
 . d LOAD^SAMIFORM(.ln,samikey,si,.filter)
"RTN","SAMIUR1",54,0)
 . i ln["PAGE NAME" d findReplace^%ts(.ln,"PAGE NAME",$$PNAME(type,datephrase))
"RTN","SAMIUR1",55,0)
 . s SAMIRTN(cnt)=ln
"RTN","SAMIUR1",56,0)
 . ;
"RTN","SAMIUR1",57,0)
 s cnt=cnt+1 s SAMIRTN(cnt)="<thead><tr>"
"RTN","SAMIUR1",58,0)
 s cnt=cnt+1 s SAMIRTN(cnt)="<th>Enrollment Date</th>"
"RTN","SAMIUR1",59,0)
 s cnt=cnt+1 s SAMIRTN(cnt)="<th>Name</th>"
"RTN","SAMIUR1",60,0)
 s cnt=cnt+1 s SAMIRTN(cnt)="<th>SSN</th>"
"RTN","SAMIUR1",61,0)
 s cnt=cnt+1 s SAMIRTN(cnt)="<th>Followup</th>"
"RTN","SAMIUR1",62,0)
 s cnt=cnt+1 s SAMIRTN(cnt)="</tr></thead>"
"RTN","SAMIUR1",63,0)
 ;
"RTN","SAMIUR1",64,0)
 ;
"RTN","SAMIUR1",65,0)
 n ij
"RTN","SAMIUR1",66,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIUR1",67,0)
 s cnt=cnt+1 s SAMIRTN(cnt)="<tbody>"
"RTN","SAMIUR1",68,0)
 s ij=0
"RTN","SAMIUR1",69,0)
 f  s ij=$o(pats(ij)) q:+ij=0  d  ;
"RTN","SAMIUR1",70,0)
 . n ij2 s ij2=0
"RTN","SAMIUR1",71,0)
 . f  s ij2=$o(pats(ij,ij2)) q:+ij2=0  d  ;
"RTN","SAMIUR1",72,0)
 . . n dfn s dfn=ij2
"RTN","SAMIUR1",73,0)
 . . n sid s sid=$g(@root@(dfn,"samistudyid"))
"RTN","SAMIUR1",74,0)
 . . n name s name=$g(@root@(dfn,"saminame"))
"RTN","SAMIUR1",75,0)
 . . n edate s edate=$g(pats(ij,dfn,"edate"))
"RTN","SAMIUR1",76,0)
 . . n cefud s cefud=$g(pats(ij,dfn,"cefud"))
"RTN","SAMIUR1",77,0)
 . . s cnt=cnt+1 s SAMIRTN(cnt)="<tr>"
"RTN","SAMIUR1",78,0)
 . . s cnt=cnt+1 s SAMIRTN(cnt)="<td>"_edate_"</td>"
"RTN","SAMIUR1",79,0)
 . . new nuhref set nuhref="<form method=POST action=""/vapals"">"
"RTN","SAMIUR1",80,0)
 . . set nuhref=nuhref_"<input type=hidden name=""samiroute"" value=""casereview"">"
"RTN","SAMIUR1",81,0)
 . . set nuhref=nuhref_"<input type=hidden name=""studyid"" value="_sid_">"
"RTN","SAMIUR1",82,0)
 . . set nuhref=nuhref_"<input value="""_name_""" class=""btn btn-link"" role=""link"" type=""submit""></form>"
"RTN","SAMIUR1",83,0)
 . . s cnt=cnt+1
"RTN","SAMIUR1",84,0)
 . . s SAMIRTN(cnt)="<td>"_nuhref_"</td>"
"RTN","SAMIUR1",85,0)
 . . n ssn s ssn=$$GETSSN^SAMIFORM(sid)
"RTN","SAMIUR1",86,0)
 . . i ssn="" d  ;
"RTN","SAMIUR1",87,0)
 . . . n hdf
"RTN","SAMIUR1",88,0)
 . . . s hdf=$$GETHDR^SAMIFLD(sid)
"RTN","SAMIUR1",89,0)
 . . . s ssn=$$GETSSN^SAMIFORM(sid)
"RTN","SAMIUR1",90,0)
 . . s cnt=cnt+1
"RTN","SAMIUR1",91,0)
 . . s SAMIRTN(cnt)="<td>"_ssn_"</td>"
"RTN","SAMIUR1",92,0)
 . . s cnt=cnt+1
"RTN","SAMIUR1",93,0)
 . . s SAMIRTN(cnt)="<td>"_cefud_"</td></tr>"
"RTN","SAMIUR1",94,0)
 ;
"RTN","SAMIUR1",95,0)
 s cnt=cnt+1 s SAMIRTN(cnt)="</tbody>"
"RTN","SAMIUR1",96,0)
 f  s ii=$o(temp(ii)) q:temp(ii)["</tbody>"  d  ;
"RTN","SAMIUR1",97,0)
 . ; skip past template headers and blank body
"RTN","SAMIUR1",98,0)
 f  s ii=$o(temp(ii)) q:+ii=0  d  ;
"RTN","SAMIUR1",99,0)
 . s cnt=cnt+1
"RTN","SAMIUR1",100,0)
 . s ln=$g(temp(ii))
"RTN","SAMIUR1",101,0)
 . d LOAD^SAMIFORM(.ln,samikey,si,.filter)
"RTN","SAMIUR1",102,0)
 . s SAMIRTN(cnt)=ln
"RTN","SAMIUR1",103,0)
 q
"RTN","SAMIUR1",104,0)
 ;
"RTN","SAMIUR1",105,0)
SELECT(SAMIPATS,type,datephrase) ; selects patient for the report
"RTN","SAMIUR1",106,0)
 i $g(type)="" s type="enrollment"
"RTN","SAMIUR1",107,0)
 s datephrase=""
"RTN","SAMIUR1",108,0)
 n zi s zi=0
"RTN","SAMIUR1",109,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIUR1",110,0)
 ;
"RTN","SAMIUR1",111,0)
 f  s zi=$o(@root@(zi)) q:+zi=0  d  ;
"RTN","SAMIUR1",112,0)
 . n sid s sid=$g(@root@(zi,"samistudyid"))
"RTN","SAMIUR1",113,0)
 . q:sid=""
"RTN","SAMIUR1",114,0)
 . n items s items=""
"RTN","SAMIUR1",115,0)
 . d GETITEMS^SAMICASE("items",sid)
"RTN","SAMIUR1",116,0)
 . q:'$d(items)
"RTN","SAMIUR1",117,0)
 . n efmdate,edate,siform,ceform,cefud,fmcefud,cedos,fmcedos
"RTN","SAMIUR1",118,0)
 . s siform=$o(items("siform-"))
"RTN","SAMIUR1",119,0)
 . s ceform=$o(items("ceform-a"),-1)
"RTN","SAMIUR1",120,0)
 . s (cefud,fmcefud,cedos,fmcedos)=""
"RTN","SAMIUR1",121,0)
 . i ceform'="" d  ;
"RTN","SAMIUR1",122,0)
 . . s cefud=$g(@root@("graph",sid,ceform,"cefud"))
"RTN","SAMIUR1",123,0)
 . . i cefud'="" s fmcefud=$$KEY2FM^SAMICASE(cefud)
"RTN","SAMIUR1",124,0)
 . . s cedos=$g(@root@("graph",sid,ceform,"cedos"))
"RTN","SAMIUR1",125,0)
 . . i cedos'="" s fmcedos=$$KEY2FM^SAMICASE(cedos)
"RTN","SAMIUR1",126,0)
 . s edate=$g(@root@("graph",sid,siform,"sidc"))
"RTN","SAMIUR1",127,0)
 . i edate="" s edate=$g(@root@("graph",sid,siform,"samicreatedate"))
"RTN","SAMIUR1",128,0)
 . s efmdate=$$KEY2FM^SAMICASE(edate)
"RTN","SAMIUR1",129,0)
 . s edate=$$VAPALSDT^SAMICASE(efmdate)
"RTN","SAMIUR1",130,0)
 . ;
"RTN","SAMIUR1",131,0)
 . i type="followup" d  ;
"RTN","SAMIUR1",132,0)
 . . n nplus30 s nplus30=$$FMADD^XLFDT($$NOW^XLFDT,31)
"RTN","SAMIUR1",133,0)
 . . ;i (+fmcefud<nplus30)!(ceform="") d  ; need ct scans
"RTN","SAMIUR1",134,0)
 . . i (+fmcefud<nplus30) d  ; need ct scans
"RTN","SAMIUR1",135,0)
 . . . i ceform="" q  ; no ct eval so no followup date
"RTN","SAMIUR1",136,0)
 . . . s SAMIPATS(efmdate,zi,"edate")=edate
"RTN","SAMIUR1",137,0)
 . . . s SAMIPATS(efmdate,zi)=""
"RTN","SAMIUR1",138,0)
 . . . i ceform="" s cefud="baseline"
"RTN","SAMIUR1",139,0)
 . . . s SAMIPATS(efmdate,zi,"cefud")=cefud
"RTN","SAMIUR1",140,0)
 . . s datephrase=" before "_$$VAPALSDT^SAMICASE(nplus30)
"RTN","SAMIUR1",141,0)
 . . q
"RTN","SAMIUR1",142,0)
 . i type="activity" d  ;
"RTN","SAMIUR1",143,0)
 . . n nminus30 s nminus30=$$FMADD^XLFDT($$NOW^XLFDT,-31)
"RTN","SAMIUR1",144,0)
 . . n anyform s anyform=$o(items("sort",""),-1)
"RTN","SAMIUR1",145,0)
 . . n fmanyform s fmanyform=$$KEY2FM^SAMICASE(anyform)
"RTN","SAMIUR1",146,0)
 . . i (+fmanyform>nminus30)!(+efmdate>nminus30) d  ; need any new form
"RTN","SAMIUR1",147,0)
 . . . s SAMIPATS(efmdate,zi,"edate")=edate
"RTN","SAMIUR1",148,0)
 . . . s SAMIPATS(efmdate,zi)=""
"RTN","SAMIUR1",149,0)
 . . . i ceform="" s cefud="baseline"
"RTN","SAMIUR1",150,0)
 . . . s SAMIPATS(efmdate,zi,"cefud")=cefud
"RTN","SAMIUR1",151,0)
 . . s datephrase=" after "_$$VAPALSDT^SAMICASE(nminus30)
"RTN","SAMIUR1",152,0)
 . ;
"RTN","SAMIUR1",153,0)
 . i type="incomplete" d  ;
"RTN","SAMIUR1",154,0)
 . . n complete s complete=1
"RTN","SAMIUR1",155,0)
 . . n zj s zj=""
"RTN","SAMIUR1",156,0)
 . . n gr s gr=$na(@root@("graph",sid))
"RTN","SAMIUR1",157,0)
 . . f  s zj=$o(@gr@(zj)) q:zj=""  d  ;
"RTN","SAMIUR1",158,0)
 . . . i $g(@gr@(zj,"samistatus"))="incomplete" s complete=0
"RTN","SAMIUR1",159,0)
 . . i complete=0 d  ; has incomplete form(s) 
"RTN","SAMIUR1",160,0)
 . . . s SAMIPATS(efmdate,zi,"edate")=edate
"RTN","SAMIUR1",161,0)
 . . . s SAMIPATS(efmdate,zi)=""
"RTN","SAMIUR1",162,0)
 . . . i ceform="" s cefud="baseline"
"RTN","SAMIUR1",163,0)
 . . . s SAMIPATS(efmdate,zi,"cefud")=cefud
"RTN","SAMIUR1",164,0)
 . . s datephrase=""
"RTN","SAMIUR1",165,0)
 . . q
"RTN","SAMIUR1",166,0)
 . i type="missingct" d  ;
"RTN","SAMIUR1",167,0)
 . . i ceform="" d  ; has incomplete form(s) 
"RTN","SAMIUR1",168,0)
 . . . s SAMIPATS(efmdate,zi,"edate")=edate
"RTN","SAMIUR1",169,0)
 . . . s SAMIPATS(efmdate,zi)=""
"RTN","SAMIUR1",170,0)
 . . . i ceform="" s cefud="baseline"
"RTN","SAMIUR1",171,0)
 . . . s SAMIPATS(efmdate,zi,"cefud")=cefud
"RTN","SAMIUR1",172,0)
 . . s datephrase=""
"RTN","SAMIUR1",173,0)
 . . q
"RTN","SAMIUR1",174,0)
 . i type="outreach" d  ;
"RTN","SAMIUR1",175,0)
 . . q
"RTN","SAMIUR1",176,0)
 . i type="enrollment" d  ;
"RTN","SAMIUR1",177,0)
 . . s SAMIPATS(efmdate,zi,"edate")=edate
"RTN","SAMIUR1",178,0)
 . . s SAMIPATS(efmdate,zi)=""
"RTN","SAMIUR1",179,0)
 . . s SAMIPATS(efmdate,zi,"cefud")=cefud
"RTN","SAMIUR1",180,0)
 . . s datephrase=" as of "_$$VAPALSDT^SAMICASE($$NOW^XLFDT)
"RTN","SAMIUR1",181,0)
 q
"RTN","SAMIUR1",182,0)
 ;
"RTN","SAMIUR1",183,0)
PNAME(type,phrase) ; extrinsic returns the PAGE NAME for the report
"RTN","SAMIUR1",184,0)
 i type="followup" q "Followup next 30 days -"_$g(phrase)
"RTN","SAMIUR1",185,0)
 i type="activity" q "Activity last 30 days -"_$g(phrase)
"RTN","SAMIUR1",186,0)
 i type="missingct" q "Intake but no CT Evaluation"_$g(phrase)
"RTN","SAMIUR1",187,0)
 i type="incomplete" q "Incomplete Forms"_$g(phrase)
"RTN","SAMIUR1",188,0)
 i type="outreach" q "Outreach"_$g(phrase)
"RTN","SAMIUR1",189,0)
 i type="enrollment" q "Enrollment"_$g(phrase)
"RTN","SAMIUR1",190,0)
 q ""
"RTN","SAMIUR1",191,0)
 ;
"RTN","SAMIUR2")
0^13^B369867052
"RTN","SAMIUR2",1,0)
SAMIUR2 ;ven/gpl - sami user reports ; 5/8/19 10:57am
"RTN","SAMIUR2",2,0)
 ;;18.0;SAM;;;Build 12
"RTN","SAMIUR2",3,0)
 ;
"RTN","SAMIUR2",4,0)
 ;@license: see routine SAMIUL
"RTN","SAMIUR2",5,0)
 ;
"RTN","SAMIUR2",6,0)
 ; SAMIUR contains the routines to generate user reports
"RTN","SAMIUR2",7,0)
 ; It is currently untested & in progress.
"RTN","SAMIUR2",8,0)
 ;
"RTN","SAMIUR2",9,0)
 quit  ; no entry from top
"RTN","SAMIUR2",10,0)
 ;
"RTN","SAMIUR2",11,0)
RPTTBL(RPT,TYPE) ; RPT is passed by reference and returns the 
"RTN","SAMIUR2",12,0)
 ; report definition table. TYPE is the report type to be returned
"RTN","SAMIUR2",13,0)
 ; This routine could use a file or a graph in the next version
"RTN","SAMIUR2",14,0)
 ;
"RTN","SAMIUR2",15,0)
 if TYPE="followup" d  q  ;
"RTN","SAMIUR2",16,0)
 . S RPT(1,"header")="F/U Date"
"RTN","SAMIUR2",17,0)
 . S RPT(1,"routine")="$$FUDATE^SAMIUR2"
"RTN","SAMIUR2",18,0)
 . S RPT(2,"header")="Name"
"RTN","SAMIUR2",19,0)
 . S RPT(2,"routine")="$$NAME^SAMIUR2"
"RTN","SAMIUR2",20,0)
 . S RPT(3,"header")="SSN"
"RTN","SAMIUR2",21,0)
 . S RPT(3,"routine")="$$SSN^SAMIUR2"
"RTN","SAMIUR2",22,0)
 . S RPT(4,"header")="Baseline Date"
"RTN","SAMIUR2",23,0)
 . S RPT(4,"routine")="$$BLINEDT^SAMIUR2"
"RTN","SAMIUR2",24,0)
 . S RPT(5,"header")="Recommend"
"RTN","SAMIUR2",25,0)
 . S RPT(5,"routine")="$$RECOM^SAMIUR2"
"RTN","SAMIUR2",26,0)
 . S RPT(6,"header")="When"
"RTN","SAMIUR2",27,0)
 . S RPT(6,"routine")="$$WHEN^SAMIUR2"
"RTN","SAMIUR2",28,0)
 . S RPT(7,"header")="Last Exam"
"RTN","SAMIUR2",29,0)
 . S RPT(7,"routine")="$$LASTEXM^SAMIUR2"
"RTN","SAMIUR2",30,0)
 . S RPT(8,"header")="Contact Information"
"RTN","SAMIUR2",31,0)
 . S RPT(8,"routine")="$$CONTACT^SAMIUR2"
"RTN","SAMIUR2",32,0)
 if TYPE="activity" d  q  ;
"RTN","SAMIUR2",33,0)
 . S RPT(1,"header")="Name"
"RTN","SAMIUR2",34,0)
 . S RPT(1,"routine")="$$NAME^SAMIUR2"
"RTN","SAMIUR2",35,0)
 . S RPT(2,"header")="SSN"
"RTN","SAMIUR2",36,0)
 . S RPT(2,"routine")="$$SSN^SAMIUR2"
"RTN","SAMIUR2",37,0)
 . S RPT(3,"header")="Study Date"
"RTN","SAMIUR2",38,0)
 . S RPT(3,"routine")="$$STUDYDT^SAMIUR2"
"RTN","SAMIUR2",39,0)
 . S RPT(4,"header")="Type"
"RTN","SAMIUR2",40,0)
 . S RPT(4,"routine")="$$STUDYTYP^SAMIUR2"
"RTN","SAMIUR2",41,0)
 . S RPT(5,"header")="CT Protocol"
"RTN","SAMIUR2",42,0)
 . S RPT(5,"routine")="$$CTPROT^SAMIUR2"
"RTN","SAMIUR2",43,0)
 . S RPT(6,"header")="Follow-up"
"RTN","SAMIUR2",44,0)
 . S RPT(6,"routine")="$$RECOM^SAMIUR2"
"RTN","SAMIUR2",45,0)
 . S RPT(7,"header")="When"
"RTN","SAMIUR2",46,0)
 . S RPT(7,"routine")="$$WHEN^SAMIUR2"
"RTN","SAMIUR2",47,0)
 . S RPT(8,"header")="on Date"
"RTN","SAMIUR2",48,0)
 . S RPT(8,"routine")="$$FUDATE^SAMIUR2"
"RTN","SAMIUR2",49,0)
 if TYPE="enrollment" d  q  ;
"RTN","SAMIUR2",50,0)
 . S RPT(1,"header")="Name"
"RTN","SAMIUR2",51,0)
 . S RPT(1,"routine")="$$NAME^SAMIUR2"
"RTN","SAMIUR2",52,0)
 . S RPT(2,"header")="SSN"
"RTN","SAMIUR2",53,0)
 . S RPT(2,"routine")="$$SSN^SAMIUR2"
"RTN","SAMIUR2",54,0)
 . S RPT(3,"header")="Study Date"
"RTN","SAMIUR2",55,0)
 . S RPT(3,"routine")="$$STUDYDT^SAMIUR2"
"RTN","SAMIUR2",56,0)
 . S RPT(4,"header")="Gender"
"RTN","SAMIUR2",57,0)
 . S RPT(4,"routine")="$$GENDER^SAMIUR2"
"RTN","SAMIUR2",58,0)
 . S RPT(5,"header")="Race"
"RTN","SAMIUR2",59,0)
 . S RPT(5,"routine")="$$RACE^SAMIUR2"
"RTN","SAMIUR2",60,0)
 . S RPT(6,"header")="Age"
"RTN","SAMIUR2",61,0)
 . S RPT(6,"routine")="$$AGE^SAMIUR2"
"RTN","SAMIUR2",62,0)
 . S RPT(7,"header")="Urban/Rural"
"RTN","SAMIUR2",63,0)
 . S RPT(7,"routine")="$$RURAL^SAMIUR2"
"RTN","SAMIUR2",64,0)
 . S RPT(8,"header")="Smoking Status"
"RTN","SAMIUR2",65,0)
 . S RPT(8,"routine")="$$SMKSTAT^SAMIUR2"
"RTN","SAMIUR2",66,0)
 . S RPT(9,"header")="Pack Years at Intake"
"RTN","SAMIUR2",67,0)
 . S RPT(9,"routine")="$$PACKYRS^SAMIUR2"
"RTN","SAMIUR2",68,0)
 if TYPE="incomplete" d  q  ;
"RTN","SAMIUR2",69,0)
 . S RPT(1,"header")="Enrollment date"
"RTN","SAMIUR2",70,0)
 . S RPT(1,"routine")="$$BLINEDT^SAMIUR2"
"RTN","SAMIUR2",71,0)
 . S RPT(2,"header")="Name"
"RTN","SAMIUR2",72,0)
 . S RPT(2,"routine")="$$NAME^SAMIUR2"
"RTN","SAMIUR2",73,0)
 . S RPT(3,"header")="SSN"
"RTN","SAMIUR2",74,0)
 . S RPT(3,"routine")="$$SSN^SAMIUR2"
"RTN","SAMIUR2",75,0)
 . S RPT(4,"header")="Incomplete form"
"RTN","SAMIUR2",76,0)
 . S RPT(4,"routine")="$$IFORM^SAMIUR2"
"RTN","SAMIUR2",77,0)
 if TYPE="missingct" d  q  ;
"RTN","SAMIUR2",78,0)
 . S RPT(1,"header")="Enrollment date"
"RTN","SAMIUR2",79,0)
 . S RPT(1,"routine")="$$BLINEDT^SAMIUR2"
"RTN","SAMIUR2",80,0)
 . S RPT(2,"header")="Name"
"RTN","SAMIUR2",81,0)
 . S RPT(2,"routine")="$$NAME^SAMIUR2"
"RTN","SAMIUR2",82,0)
 . S RPT(3,"header")="SSN"
"RTN","SAMIUR2",83,0)
 . S RPT(3,"routine")="$$SSN^SAMIUR2"
"RTN","SAMIUR2",84,0)
 if TYPE="cumpy" d  q  ;
"RTN","SAMIUR2",85,0)
 . S RPT(1,"header")="Name"
"RTN","SAMIUR2",86,0)
 . S RPT(1,"routine")="$$NAME^SAMIUR2"
"RTN","SAMIUR2",87,0)
 . S RPT(2,"header")="Study ID"
"RTN","SAMIUR2",88,0)
 . S RPT(2,"routine")="$$SID^SAMIUR2"
"RTN","SAMIUR2",89,0)
 . S RPT(3,"header")="Form Values"
"RTN","SAMIUR2",90,0)
 . S RPT(3,"routine")="$$VALS^SAMIUR2"
"RTN","SAMIUR2",91,0)
 . S RPT(4,"header")="Smoking History"
"RTN","SAMIUR2",92,0)
 . S RPT(4,"routine")="$$SMHIS^SAMIUR2"
"RTN","SAMIUR2",93,0)
 if TYPE="unmatched" d  ;
"RTN","SAMIUR2",94,0)
 . S RPT(1,"header")="Unmatched Entry"
"RTN","SAMIUR2",95,0)
 . S RPT(1,"routine")="$$MANPAT^SAMIUR2"
"RTN","SAMIUR2",96,0)
 . S RPT(2,"header")="Possible Match"
"RTN","SAMIUR2",97,0)
 . S RPT(2,"routine")="$$POSSIBLE^SAMIUR2"
"RTN","SAMIUR2",98,0)
 . S RPT(3,"header")="Match Control"
"RTN","SAMIUR2",99,0)
 . S RPT(3,"routine")="$$MATCH^SAMIUR2"
"RTN","SAMIUR2",100,0)
 if TYPE="worklist" d  q  ;
"RTN","SAMIUR2",101,0)
 . S RPT(1,"header")="Name"
"RTN","SAMIUR2",102,0)
 . S RPT(1,"routine")="$$WORKPAT^SAMIUR2"
"RTN","SAMIUR2",103,0)
 . S RPT(2,"header")="SSN"
"RTN","SAMIUR2",104,0)
 . S RPT(2,"routine")="$$SSN^SAMIUR2"
"RTN","SAMIUR2",105,0)
 . S RPT(3,"header")="Date of birth"
"RTN","SAMIUR2",106,0)
 . S RPT(3,"routine")="$$DOB^SAMIUR2"
"RTN","SAMIUR2",107,0)
 . S RPT(4,"header")="Gender"
"RTN","SAMIUR2",108,0)
 . S RPT(4,"routine")="$$GENDER^SAMIUR2"
"RTN","SAMIUR2",109,0)
 ;
"RTN","SAMIUR2",110,0)
 q
"RTN","SAMIUR2",111,0)
 ;
"RTN","SAMIUR2",112,0)
SID(zdt,dfn,SAMIPATS) ; extrinsic returns SID
"RTN","SAMIUR2",113,0)
 q $$DFN2SID(dfn)
"RTN","SAMIUR2",114,0)
 ;
"RTN","SAMIUR2",115,0)
DFN2SID(DFN) ;extrinsic returns the studyid for patient DFN
"RTN","SAMIUR2",116,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIUR2",117,0)
 q $g(@root@(DFN,"sisid"))
"RTN","SAMIUR2",118,0)
 ;
"RTN","SAMIUR2",119,0)
FUDATE(zdt,dfn,SAMIPATS) ; extrinsic returns followup date
"RTN","SAMIUR2",120,0)
 n fud
"RTN","SAMIUR2",121,0)
 s fud="fudate"
"RTN","SAMIUR2",122,0)
 q $g(SAMIPATS(zdt,dfn,"cefud"))
"RTN","SAMIUR2",123,0)
 ;
"RTN","SAMIUR2",124,0)
NAME(zdt,dfn,SAMIPATS) ; extrinsic returns the name including a hyperlink
"RTN","SAMIUR2",125,0)
 n nam
"RTN","SAMIUR2",126,0)
 s nam="Name"
"RTN","SAMIUR2",127,0)
 q $g(SAMIPATS(zdt,dfn,"nuhref"))
"RTN","SAMIUR2",128,0)
 ;
"RTN","SAMIUR2",129,0)
SSN(zdt,dfn,SAMIPATS) ; extrinsic returns SSN
"RTN","SAMIUR2",130,0)
 n ssn,tssn
"RTN","SAMIUR2",131,0)
 s tssn=$g(SAMIPATS(zdt,dfn,"ssn"))
"RTN","SAMIUR2",132,0)
 s ssn=tssn
"RTN","SAMIUR2",133,0)
 i ssn'["-" s ssn=$e(tssn,1,3)_"-"_$e(tssn,4,5)_"-"_$e(tssn,6,9)
"RTN","SAMIUR2",134,0)
 q ssn
"RTN","SAMIUR2",135,0)
 ;
"RTN","SAMIUR2",136,0)
BLINEDT(zdt,dfn,SAMIPATS) ; extrinsic returns Baseline Date
"RTN","SAMIUR2",137,0)
 n bldt
"RTN","SAMIUR2",138,0)
 s bldt=$g(SAMIPATS(zdt,dfn,"edate"))
"RTN","SAMIUR2",139,0)
 q bldt
"RTN","SAMIUR2",140,0)
 ;
"RTN","SAMIUR2",141,0)
WHEN(zdt,dfn,SAMIPATS) ; extrinsic returns followup text ie. "in one year"
"RTN","SAMIUR2",142,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIUR2",143,0)
 n ceform s ceform=$g(SAMIPATS(zdt,dfn,"ceform"))
"RTN","SAMIUR2",144,0)
 n sid s sid=$g(@root@(dfn,"samistudyid"))
"RTN","SAMIUR2",145,0)
 q:ceform="" ""
"RTN","SAMIUR2",146,0)
 n vals s vals=$na(@root@("graph",sid,ceform))
"RTN","SAMIUR2",147,0)
 n DICT
"RTN","SAMIUR2",148,0)
 s DICT("cefuw","1m")="in one month"
"RTN","SAMIUR2",149,0)
 s DICT("cefuw","1y")="in one year"
"RTN","SAMIUR2",150,0)
 s DICT("cefuw","3m")="in three months"
"RTN","SAMIUR2",151,0)
 s DICT("cefuw","6m")="in six months"
"RTN","SAMIUR2",152,0)
 s DICT("cefuw","os")="other as specified"
"RTN","SAMIUR2",153,0)
 n whnx s whnx=$g(@vals@("cefuw"))
"RTN","SAMIUR2",154,0)
 q:whnx="" ""
"RTN","SAMIUR2",155,0)
 s whn=$g(DICT("cefuw",whnx))
"RTN","SAMIUR2",156,0)
 q whn
"RTN","SAMIUR2",157,0)
 ;
"RTN","SAMIUR2",158,0)
LASTEXM(zdt,dfn,SAMIPATS) ; extrinsic returns patient last exam
"RTN","SAMIUR2",159,0)
 n lexm
"RTN","SAMIUR2",160,0)
 s lexm=$g(SAMIPATS(zdt,dfn,"cedos"))
"RTN","SAMIUR2",161,0)
 q lexm
"RTN","SAMIUR2",162,0)
 ;
"RTN","SAMIUR2",163,0)
STATUS(zdt,dfn,SAMIPATS) ; extrinsic returns patient status
"RTN","SAMIUR2",164,0)
 n stat
"RTN","SAMIUR2",165,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIUR2",166,0)
 n sid s sid=$g(@root@(dfn,"samistudyid"))
"RTN","SAMIUR2",167,0)
 n siform s siform=$g(SAMIPATS(zdt,dfn,"siform"))
"RTN","SAMIUR2",168,0)
 n vals s vals=$na(@root@("graph",sid,siform))
"RTN","SAMIUR2",169,0)
 s stat=$g(@vals@("sistatus"))
"RTN","SAMIUR2",170,0)
 q stat
"RTN","SAMIUR2",171,0)
 ;
"RTN","SAMIUR2",172,0)
CONTACT(zdt,dfn,SAMIPATS) ; extrinsic returns patient street address
"RTN","SAMIUR2",173,0)
 n contact s contact=""
"RTN","SAMIUR2",174,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIUR2",175,0)
 n sid s sid=$g(@root@(dfn,"samistudyid"))
"RTN","SAMIUR2",176,0)
 n siform s siform=$g(SAMIPATS(zdt,dfn,"siform"))
"RTN","SAMIUR2",177,0)
 n vals s vals=$na(@root@("graph",sid,siform))
"RTN","SAMIUR2",178,0)
 s contact=$g(@vals@("sinamef"))_" "_$g(@vals@("sinamel"))
"RTN","SAMIUR2",179,0)
 s contact=contact_"<br>"_$g(@vals@("sipsa"))
"RTN","SAMIUR2",180,0)
 i $g(@vals@("sipan"))'="" s contact=contact_" Apt "_$g(@vals@("sipan"))
"RTN","SAMIUR2",181,0)
 i $g(@vals@("sipcn"))'="" s contact=contact_"<br>County "_@vals@("sipcn")
"RTN","SAMIUR2",182,0)
 i $g(@vals@("sipc"))'="" s contact=contact_" <br>"_@vals@("sipc")_", "
"RTN","SAMIUR2",183,0)
 s contact=contact_" "_$g(@vals@("sips"))_" "_$g(@vals@("sipz"))_"     "
"RTN","SAMIUR2",184,0)
 q contact
"RTN","SAMIUR2",185,0)
 ;
"RTN","SAMIUR2",186,0)
STUDYDT(zdt,dfn,SAMIPATS) ; extrinsic returns the lastest Study Date
"RTN","SAMIUR2",187,0)
 n stdt
"RTN","SAMIUR2",188,0)
 s stdt=$g(SAMIPATS(zdt,dfn,"cedos"))
"RTN","SAMIUR2",189,0)
 q stdt
"RTN","SAMIUR2",190,0)
 ;
"RTN","SAMIUR2",191,0)
STUDYTYP(zdt,dfn,SAMIPATS) ; extrinsic returns the latest Study Type
"RTN","SAMIUR2",192,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIUR2",193,0)
 n ceform s ceform=$g(SAMIPATS(zdt,dfn,"ceform"))
"RTN","SAMIUR2",194,0)
 n sid s sid=$g(@root@(dfn,"samistudyid"))
"RTN","SAMIUR2",195,0)
 q:ceform="" ""
"RTN","SAMIUR2",196,0)
 n vals s vals=$na(@root@("graph",sid,ceform))
"RTN","SAMIUR2",197,0)
 n stypx,styp
"RTN","SAMIUR2",198,0)
 s stypx=$g(@vals@("cetex"))
"RTN","SAMIUR2",199,0)
 s styp=$s(stypx="a":"Annual",stypx="b":"Baseline",stypx="d":"Followup",1:"")
"RTN","SAMIUR2",200,0)
 q styp
"RTN","SAMIUR2",201,0)
 ;
"RTN","SAMIUR2",202,0)
CTPROT(zdt,dfn,SAMIPATS) ; extrinsic returns the CT Protocol
"RTN","SAMIUR2",203,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIUR2",204,0)
 n ceform s ceform=$g(SAMIPATS(zdt,dfn,"ceform"))
"RTN","SAMIUR2",205,0)
 n sid s sid=$g(@root@(dfn,"samistudyid"))
"RTN","SAMIUR2",206,0)
 q:ceform="" ""
"RTN","SAMIUR2",207,0)
 n vals s vals=$na(@root@("graph",sid,ceform))
"RTN","SAMIUR2",208,0)
 n cectp s cectp=$g(@vals@("cectp"))
"RTN","SAMIUR2",209,0)
 n ctyp
"RTN","SAMIUR2",210,0)
 s ctyp=$s(cectp="l":"Low-Dose CT",cectp="d":"Standard CT",cectp="i":"Limited",1:"")
"RTN","SAMIUR2",211,0)
 q ctyp
"RTN","SAMIUR2",212,0)
 ;
"RTN","SAMIUR2",213,0)
RECOM(zdt,dfn,SAMIPATS) ; extrinsic returns Recommendation
"RTN","SAMIUR2",214,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIUR2",215,0)
 n ceform s ceform=$g(SAMIPATS(zdt,dfn,"ceform"))
"RTN","SAMIUR2",216,0)
 n sid s sid=$g(@root@(dfn,"samistudyid"))
"RTN","SAMIUR2",217,0)
 q:ceform="" ""
"RTN","SAMIUR2",218,0)
 n vals s vals=$na(@root@("graph",sid,ceform))
"RTN","SAMIUR2",219,0)
 n cefuw s cefuw=$g(@vals@("cefuw"))
"RTN","SAMIUR2",220,0)
 n recom s recom=""
"RTN","SAMIUR2",221,0)
 s recom=$s(cefuw="1y":"Annual Repeat",cefuw="nw":"Now",cefuw="1m":"1 month",cefuw="3m":"3 months",cefuw="6m":"6 months",cefuw="os":"Other",1:"")
"RTN","SAMIUR2",222,0)
 i $g(@vals@("cefuaf"))="y" s recom=recom_", Antibiotics"
"RTN","SAMIUR2",223,0)
 i $g(@vals@("cefucc"))="y" s recom=recom_", Contrast CT"
"RTN","SAMIUR2",224,0)
 i $g(@vals@("cefupe"))="y" s recom=recom_", PET"
"RTN","SAMIUR2",225,0)
 i $g(@vals@("cefufn"))="y" s recom=recom_", Percutaneous biopsy"
"RTN","SAMIUR2",226,0)
 i $g(@vals@("cefubr"))="y" s recom=recom_", Bronchoscopy"
"RTN","SAMIUR2",227,0)
 i $g(@vals@("cefupc"))="y" s recom=recom_", Pulmonary consultation"
"RTN","SAMIUR2",228,0)
 i $g(@vals@("cefutb"))="y" s recom=recom_", Refer to tumor board"
"RTN","SAMIUR2",229,0)
 i $g(@vals@("cefunf"))="y" s recom=recom_", No other further follow-up"
"RTN","SAMIUR2",230,0)
 i $e(recom,1,2)=", " s recom=$e(recom,3,$l(recom))
"RTN","SAMIUR2",231,0)
 q recom
"RTN","SAMIUR2",232,0)
 ;
"RTN","SAMIUR2",233,0)
GENDER(zdt,dfn,SAMIPATS) ; extrinsic returns gender
"RTN","SAMIUR2",234,0)
 ;n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIUR2",235,0)
 n gend
"RTN","SAMIUR2",236,0)
 ;s gend=$g(@root@(dfn,"gender"))
"RTN","SAMIUR2",237,0)
 s gend=$g(SAMIPATS(zdt,dfn,"sex"))
"RTN","SAMIUR2",238,0)
 i gend="" s gend=$g(SAMIPATS(zdt,dfn,"gender"))
"RTN","SAMIUR2",239,0)
 q:gend="" ""
"RTN","SAMIUR2",240,0)
 i gend["^" s gend=$p(gend,"^",2)
"RTN","SAMIUR2",241,0)
 q gend
"RTN","SAMIUR2",242,0)
 ;
"RTN","SAMIUR2",243,0)
RACE(zdt,dfn,SAMIPATS) ; extrinsic returns race
"RTN","SAMIUR2",244,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIUR2",245,0)
 n race s race=$g(@root@(dfn,"race"))
"RTN","SAMIUR2",246,0)
 q:race="" ""
"RTN","SAMIUR2",247,0)
 q race
"RTN","SAMIUR2",248,0)
 ;
"RTN","SAMIUR2",249,0)
ETHNCTY(zdt,dfn,SAMIPATS) ; extrinsic returns ethnicity
"RTN","SAMIUR2",250,0)
 q "ethnicity"
"RTN","SAMIUR2",251,0)
 ;
"RTN","SAMIUR2",252,0)
AGE(zdt,dfn,SAMIPATS) ; extrinsic returns age
"RTN","SAMIUR2",253,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIUR2",254,0)
 n dob,age
"RTN","SAMIUR2",255,0)
 set dob=$get(@root@(dfn,"sbdob")) ; dob in VAPALS format
"RTN","SAMIUR2",256,0)
 ;
"RTN","SAMIUR2",257,0)
 new X,Y
"RTN","SAMIUR2",258,0)
 set X=dob
"RTN","SAMIUR2",259,0)
 do ^%DT
"RTN","SAMIUR2",260,0)
 set age=$piece($$FMDIFF^XLFDT($$NOW^XLFDT,Y)/365,".")
"RTN","SAMIUR2",261,0)
 q age
"RTN","SAMIUR2",262,0)
 ;
"RTN","SAMIUR2",263,0)
SMKSTAT(zdt,dfn,SAMIPATS) ; extrinsic returns smoking status
"RTN","SAMIUR2",264,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIUR2",265,0)
 n sid s sid=$g(@root@(dfn,"samistudyid"))
"RTN","SAMIUR2",266,0)
 n siform s siform=$g(SAMIPATS(zdt,dfn,"siform"))
"RTN","SAMIUR2",267,0)
 n vals s vals=$na(@root@("graph",sid,siform))
"RTN","SAMIUR2",268,0)
 n smk
"RTN","SAMIUR2",269,0)
 s smk="unknown"
"RTN","SAMIUR2",270,0)
 if $g(@vals@("siesm"))="n" s smk="Never smoked"
"RTN","SAMIUR2",271,0)
 if $g(@vals@("siesm"))="p" s smk="Past smoker"
"RTN","SAMIUR2",272,0)
 if $g(@vals@("siesm"))="c" s smk="Current smoker"
"RTN","SAMIUR2",273,0)
 ;if $g(@vals@("siesq"))=1 s smk="Cu"
"RTN","SAMIUR2",274,0)
 q smk
"RTN","SAMIUR2",275,0)
 ;
"RTN","SAMIUR2",276,0)
PACKYRS(zdt,dfn,SAMIPATS) ; extrinsic returns smoking status
"RTN","SAMIUR2",277,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIUR2",278,0)
 n sid s sid=$g(@root@(dfn,"samistudyid"))
"RTN","SAMIUR2",279,0)
 n siform s siform=$g(SAMIPATS(zdt,dfn,"siform"))
"RTN","SAMIUR2",280,0)
 n vals s vals=$na(@root@("graph",sid,siform))
"RTN","SAMIUR2",281,0)
 n pkyrs
"RTN","SAMIUR2",282,0)
 s pkyrs=$g(@vals@("sippy"))
"RTN","SAMIUR2",283,0)
 q pkyrs
"RTN","SAMIUR2",284,0)
 ;
"RTN","SAMIUR2",285,0)
IFORM(zdt,dfn,SAMIPATS) ; extrinsic returns the name(s) of the incomplete forms
"RTN","SAMIUR2",286,0)
 n iform s iform=$g(SAMIPATS(zdt,dfn,"iform"))
"RTN","SAMIUR2",287,0)
 q:iform="" ""  ;
"RTN","SAMIUR2",288,0)
 n return,zkey1,zn,typ
"RTN","SAMIUR2",289,0)
 s return="<table>"
"RTN","SAMIUR2",290,0)
 f zn=2:1  q:$p(iform," ",zn)=""  d  ;
"RTN","SAMIUR2",291,0)
 . s return=return_"<tr><td>"
"RTN","SAMIUR2",292,0)
 . s zkey1=$p(iform," ",zn)
"RTN","SAMIUR2",293,0)
 . n fname
"RTN","SAMIUR2",294,0)
 . if zkey1["ceform" set fname="CT Evaluation" set typ="ceform"
"RTN","SAMIUR2",295,0)
 . if zkey1["sbform" set fname="Background" set typ="sbform"
"RTN","SAMIUR2",296,0)
 . if zkey1["fuform" set fname="Follow-up" set typ="fuform"
"RTN","SAMIUR2",297,0)
 . if zkey1["bxform" set fname="Biopsy" set typ="bxform"
"RTN","SAMIUR2",298,0)
 . if zkey1["ptform" set fname="PET Evaluation" set typ="ptform"
"RTN","SAMIUR2",299,0)
 . if zkey1["itform" set fname="Intervention" set typ="itform"
"RTN","SAMIUR2",300,0)
 . if zkey1["siform" set fname="Intake Form" set typ="siform"
"RTN","SAMIUR2",301,0)
 . if $get(fname)="" set fname="unknown" set typ=""
"RTN","SAMIUR2",302,0)
 . ;
"RTN","SAMIUR2",303,0)
 . n sid s sid=$$DFN2SID^SAMIUR2(dfn)
"RTN","SAMIUR2",304,0)
 . n zdate s zdate=$$VAPALSDT^SAMICASE($$KEY2FM^SAMICASE(zkey1))
"RTN","SAMIUR2",305,0)
 . s return=return_$$MKNAV(sid,zkey1,fname_" - "_zdate,typ)
"RTN","SAMIUR2",306,0)
 . s return=return_"</td></tr>"
"RTN","SAMIUR2",307,0)
 s return=return_"</table>"
"RTN","SAMIUR2",308,0)
 q return
"RTN","SAMIUR2",309,0)
 ;
"RTN","SAMIUR2",310,0)
MKNAV(sid,zform,fname,form) ; extrinsic return html for navigation to a form
"RTN","SAMIUR2",311,0)
 ;
"RTN","SAMIUR2",312,0)
 n rtn
"RTN","SAMIUR2",313,0)
 set rtn="<form method=""post"" action=""/vapals"">"
"RTN","SAMIUR2",314,0)
 set rtn=rtn_"<input name=""samiroute"" value=""form"" type=""hidden"">"
"RTN","SAMIUR2",315,0)
 set rtn=rtn_" <input name=""studyid"" value="""_sid_""" type=""hidden"">"
"RTN","SAMIUR2",316,0)
 set rtn=rtn_" <input name=""form"" value=""vapals:"_zform_""" type=""hidden"">"
"RTN","SAMIUR2",317,0)
 set rtn=rtn_" <input value="""_fname_""" class=""btn btn-link"" role=""link"" type=""submit""></form>"_$char(13)
"RTN","SAMIUR2",318,0)
 q rtn
"RTN","SAMIUR2",319,0)
 ;
"RTN","SAMIUR2",320,0)
RURAL(zdt,dfn,SAMIPATS) ; extrinsic which returns the rural/urban status
"RTN","SAMIUR2",321,0)
 ; of the patient
"RTN","SAMIUR2",322,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIUR2",323,0)
 n sid s sid=$g(@root@(dfn,"samistudyid"))
"RTN","SAMIUR2",324,0)
 n siform s siform=$g(SAMIPATS(zdt,dfn,"siform"))
"RTN","SAMIUR2",325,0)
 n vals s vals=$na(@root@("graph",sid,siform))
"RTN","SAMIUR2",326,0)
 n sirs
"RTN","SAMIUR2",327,0)
 s sirs=$g(@vals@("sirs"))
"RTN","SAMIUR2",328,0)
 s sirs=$s(sirs="r":"rural",sirs="u":"urban",sirs="n":"unknown",1:"unknown")
"RTN","SAMIUR2",329,0)
 q sirs
"RTN","SAMIUR2",330,0)
 ;
"RTN","SAMIUR2",331,0)
VALS(zdt,dfn,SAMIPATS) ; extrinsic returns contents of form values cell
"RTN","SAMIUR2",332,0)
 n vrtn s vrtn=""
"RTN","SAMIUR2",333,0)
 n vsid s vsid=$$DFN2SID(dfn)
"RTN","SAMIUR2",334,0)
 n vgr s vgr="/vals?sid="_vsid_"&form="
"RTN","SAMIUR2",335,0)
 q:'$d(SAMIPATS)
"RTN","SAMIUR2",336,0)
 n vzi s vzi=""
"RTN","SAMIUR2",337,0)
 f  s vzi=$o(SAMIPATS(zdt,dfn,"items",vzi)) q:vzi="sort"  q:vzi=""  d  ;
"RTN","SAMIUR2",338,0)
 . s vrtn=vrtn_"<a href="""_vgr_vzi_""">"_vzi_"</a><br>"
"RTN","SAMIUR2",339,0)
 q vrtn
"RTN","SAMIUR2",340,0)
 ;
"RTN","SAMIUR2",341,0)
WSVALS(RTN,FILTER) ;web service to display form values from the graph
"RTN","SAMIUR2",342,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIUR2",343,0)
 n sid s sid=$g(FILTER("sid"))
"RTN","SAMIUR2",344,0)
 i sid="" s sid=$g(FILTER("studyid"))
"RTN","SAMIUR2",345,0)
 q:sid=""
"RTN","SAMIUR2",346,0)
 n zform s zform=$g(FILTER("form"))
"RTN","SAMIUR2",347,0)
 n groot
"RTN","SAMIUR2",348,0)
 i zform="" s groot=$na(@root@("graph",sid))
"RTN","SAMIUR2",349,0)
 e  s groot=$na(@root@("graph",sid,zform))
"RTN","SAMIUR2",350,0)
 s FILTER("root")=$e(groot,2,$l(groot))
"RTN","SAMIUR2",351,0)
 d wsGtree^SYNVPR(.RTN,.FILTER)
"RTN","SAMIUR2",352,0)
 q
"RTN","SAMIUR2",353,0)
 ;
"RTN","SAMIUR2",354,0)
PKYDT(STDT,ENDT,PKS,CIGS) ; Extrinsic returns pack-years
"RTN","SAMIUR2",355,0)
 ; if PKS is not provided, 20/CIGS will be used for packs per day
"RTN","SAMIUR2",356,0)
 n pkyr s pkyr=""
"RTN","SAMIUR2",357,0)
 i $g(PKS)="" d  ;
"RTN","SAMIUR2",358,0)
 . i $g(CIGS)="" s PKS=0 q  ;
"RTN","SAMIUR2",359,0)
 . s PKS=20/CIGS
"RTN","SAMIUR2",360,0)
 n zst,zend,zdif
"RTN","SAMIUR2",361,0)
 s zst=$$FMDT(STDT)
"RTN","SAMIUR2",362,0)
 i zst=-1 s zst=STDT
"RTN","SAMIUR2",363,0)
 s zend=$$FMDT(ENDT)
"RTN","SAMIUR2",364,0)
 i zend=-1 s zend=ENDT ; probably a fileman date already
"RTN","SAMIUR2",365,0)
 s zdif=$$FMDIFF^XLFDT(zend,zst)/365.24
"RTN","SAMIUR2",366,0)
 s pkyr=$$PKY(zdif,PKS)
"RTN","SAMIUR2",367,0)
 ;
"RTN","SAMIUR2",368,0)
 q pkyr
"RTN","SAMIUR2",369,0)
 ;
"RTN","SAMIUR2",370,0)
PKY(YRS,PKS) ; Extrinsic returns pack-years from years (YRS) and 
"RTN","SAMIUR2",371,0)
 ; packs per day (PKS)
"RTN","SAMIUR2",372,0)
 ;
"RTN","SAMIUR2",373,0)
 n rtn s rtn=""
"RTN","SAMIUR2",374,0)
 s rtn=YRS*PKS
"RTN","SAMIUR2",375,0)
 i $l($p(rtn,".",2))>2 d  ;
"RTN","SAMIUR2",376,0)
 . n zdec s zdec=$p(rtn,".",2)
"RTN","SAMIUR2",377,0)
 . s rtn=$p(rtn,".",1)_"."_$e(zdec,1,2)
"RTN","SAMIUR2",378,0)
 . i $e(zdec,3)>4 s rtn=rtn+.01
"RTN","SAMIUR2",379,0)
 i rtn'["." s rtn=rtn_".0"
"RTN","SAMIUR2",380,0)
 q rtn
"RTN","SAMIUR2",381,0)
 ;
"RTN","SAMIUR2",382,0)
FMDT(ZDT) ; Extrinsic returns the fileman date of ZDT
"RTN","SAMIUR2",383,0)
 N X,Y
"RTN","SAMIUR2",384,0)
 S X=ZDT
"RTN","SAMIUR2",385,0)
 D ^%DT
"RTN","SAMIUR2",386,0)
 Q Y
"RTN","SAMIUR2",387,0)
 ;
"RTN","SAMIUR2",388,0)
SMHIS(zdt,dfn,SAMIPATS) ; extrinsic returns contents of smoking history cell
"RTN","SAMIUR2",389,0)
 ;
"RTN","SAMIUR2",390,0)
 n zrtn s zrtn=""
"RTN","SAMIUR2",391,0)
 s zrtn=zrtn_"<div class=""row""><div class=""col-md-12""><table class=""table"" id=""pack-years-history"">"
"RTN","SAMIUR2",392,0)
 s zrtn=zrtn_"<thead><tr><th>Form </th><th> Reported Date </th>"
"RTN","SAMIUR2",393,0)
 s zrtn=zrtn_"<th>Pack Years</th><th>Cumulative</th></tr></thead><tbody>"
"RTN","SAMIUR2",394,0)
 s zrtn=zrtn_$$SHDET($$DFN2SID(dfn))
"RTN","SAMIUR2",395,0)
 s zrtn=zrtn_"</tbody></table></div></div>"
"RTN","SAMIUR2",396,0)
 q zrtn
"RTN","SAMIUR2",397,0)
 ;
"RTN","SAMIUR2",398,0)
SHDET(SID,KEY) ; Extrinsic returns table contents for smoking history
"RTN","SAMIUR2",399,0)
 ; KEY is the form key of the caller for "current" marker insertion
"RTN","SAMIUR2",400,0)
 n pyary
"RTN","SAMIUR2",401,0)
 i $g(KEY)="" s KEY=""
"RTN","SAMIUR2",402,0)
 d CUMPY("pyary",SID,KEY)
"RTN","SAMIUR2",403,0)
 n current s current=$g(pyary("current"))
"RTN","SAMIUR2",404,0)
 n rptcnt,rptmax
"RTN","SAMIUR2",405,0)
 s rptcnt=0
"RTN","SAMIUR2",406,0)
 s rptmax=$o(pyary("rpt",""),-1)
"RTN","SAMIUR2",407,0)
 q:+rptmax=0
"RTN","SAMIUR2",408,0)
 n return
"RTN","SAMIUR2",409,0)
 s return=""
"RTN","SAMIUR2",410,0)
 n zi s zi=""
"RTN","SAMIUR2",411,0)
 f zi=1:1:rptmax d  ;
"RTN","SAMIUR2",412,0)
 . s rptcnt=rptcnt+1
"RTN","SAMIUR2",413,0)
 . i rptcnt=current s return=return_"<tr data-current-form=""true"">"
"RTN","SAMIUR2",414,0)
 . e  s return=return_"<tr>"
"RTN","SAMIUR2",415,0)
 . s return=return_"<td>"_pyary("rpt",rptcnt,1)_"</td>"
"RTN","SAMIUR2",416,0)
 . s return=return_"<td class=""reported-date"">"_pyary("rpt",rptcnt,2)_"</td>"
"RTN","SAMIUR2",417,0)
 . s return=return_"<td class=""pack-years"">"_pyary("rpt",rptcnt,3)_"</td>"
"RTN","SAMIUR2",418,0)
 . s return=return_"<td class=""cumulative-pack-years"">"_pyary("rpt",rptcnt,4)_"</td>"
"RTN","SAMIUR2",419,0)
 . s return=return_"</tr>"
"RTN","SAMIUR2",420,0)
 k pyary
"RTN","SAMIUR2",421,0)
 q return
"RTN","SAMIUR2",422,0)
 ;
"RTN","SAMIUR2",423,0)
DOB(ien,dfn,SAMIPATS) ; extrinsic returns the Date of Birth
"RTN","SAMIUR2",424,0)
 n dob
"RTN","SAMIUR2",425,0)
 s dob=$g(SAMIPATS(ien,dfn,"dob"))
"RTN","SAMIUR2",426,0)
 i dob="" s dob=$g(SAMIPATS(ien,dfn,"sbdob"))
"RTN","SAMIUR2",427,0)
 q dob
"RTN","SAMIUR2",428,0)
 ;
"RTN","SAMIUR2",429,0)
WORKPAT(ien,dfn,SAMIPATS) ; extrinsic returns worklist patient name cell
"RTN","SAMIUR2",430,0)
 n zcell
"RTN","SAMIUR2",431,0)
 s zcell=""
"RTN","SAMIUR2",432,0)
 s zcell=zcell_$g(SAMIPATS(ien,dfn,"workref"))
"RTN","SAMIUR2",433,0)
 q zcell
"RTN","SAMIUR2",434,0)
 ;
"RTN","SAMIUR2",435,0)
MANPAT(ien,dfn,SAMIPATS) ; extrinsic returns the unmatched patient cell
"RTN","SAMIUR2",436,0)
 n zcell
"RTN","SAMIUR2",437,0)
 s zcell=""
"RTN","SAMIUR2",438,0)
 ;s zcell=zcell_$g(SAMIPATS(ien,dfn,"saminame"))
"RTN","SAMIUR2",439,0)
 s zcell=zcell_$g(SAMIPATS(ien,dfn,"editref"))
"RTN","SAMIUR2",440,0)
 s zcell=zcell_"<br>Date of Birth: "_$g(SAMIPATS(ien,dfn,"dob"))
"RTN","SAMIUR2",441,0)
 s zcell=zcell_" Gender: "_$g(SAMIPATS(ien,dfn,"sex"))
"RTN","SAMIUR2",442,0)
 n ssn s ssn=$g(SAMIPATS(ien,dfn,"ssn"))
"RTN","SAMIUR2",443,0)
 i ssn="" d  ;
"RTN","SAMIUR2",444,0)
 . n lroot s lroot=$$setroot^%wd("patient-lookup")
"RTN","SAMIUR2",445,0)
 . n tssn s tssn=$g(@lroot@(ien,"ssn"))
"RTN","SAMIUR2",446,0)
 . s ssn=$e(tssn,1,3)_"-"_$e(tssn,4,5)_"-"_$e(tssn,6,9)
"RTN","SAMIUR2",447,0)
 s zcell=zcell_"<br>SSN: "_ssn
"RTN","SAMIUR2",448,0)
 s zcell=zcell_"<br>dfn: "_dfn
"RTN","SAMIUR2",449,0)
 q zcell
"RTN","SAMIUR2",450,0)
 ;
"RTN","SAMIUR2",451,0)
POSSIBLE(ien,dfn,SAMIPATS) ; extrinsic returns possible match cell
"RTN","SAMIUR2",452,0)
 n zcell
"RTN","SAMIUR2",453,0)
 s zcell=""
"RTN","SAMIUR2",454,0)
 n matien s matien=$g(SAMIPATS(ien,dfn,"MATCHLOG"))
"RTN","SAMIUR2",455,0)
 i matien="" q zcell
"RTN","SAMIUR2",456,0)
 n lroot s lroot=$$setroot^%wd("patient-lookup")
"RTN","SAMIUR2",457,0)
 i '$d(@lroot@(matien)) q zcell
"RTN","SAMIUR2",458,0)
 s zcell=zcell_$g(@lroot@(matien,"saminame"))
"RTN","SAMIUR2",459,0)
 s zcell=zcell_"<br>Date of Birth: "_$g(@lroot@(matien,"sbdob"))
"RTN","SAMIUR2",460,0)
 s zcell=zcell_" Gender: "_$g(@lroot@(matien,"sex"))
"RTN","SAMIUR2",461,0)
 n tssn s tssn=$g(@lroot@(matien,"ssn"))
"RTN","SAMIUR2",462,0)
 n ssn s ssn=tssn
"RTN","SAMIUR2",463,0)
 i tssn'["-" s ssn=$e(tssn,1,3)_"-"_$e(tssn,4,5)_"-"_$e(tssn,6,9)
"RTN","SAMIUR2",464,0)
 s zcell=zcell_"<br>SSN: "_ssn
"RTN","SAMIUR2",465,0)
 s zcell=zcell_"<br>dfn: "_$g(@lroot@(matien,"dfn"))
"RTN","SAMIUR2",466,0)
 ;
"RTN","SAMIUR2",467,0)
 q zcell
"RTN","SAMIUR2",468,0)
 ;
"RTN","SAMIUR2",469,0)
MATCH(ien,dfn,SAMIPATS) ; extrinsic returns the match button cell
"RTN","SAMIUR2",470,0)
 ;
"RTN","SAMIUR2",471,0)
 n matien s matien=$g(SAMIPATS(ien,dfn,"MATCHLOG"))
"RTN","SAMIUR2",472,0)
 i matien="" q ""
"RTN","SAMIUR2",473,0)
 ;
"RTN","SAMIUR2",474,0)
 new nuhref set nuhref="<form method=POST action=""/vapals"">"
"RTN","SAMIUR2",475,0)
 set nuhref=nuhref_"<input type=hidden name=""samiroute"" value=""merge"">"
"RTN","SAMIUR2",476,0)
 set nuhref=nuhref_"<input type=hidden name=""toien"" value="_ien_">"
"RTN","SAMIUR2",477,0)
 set nuhref=nuhref_"<input value=""Merge"" class=""btn btn-link"" role=""link"" type=""submit""></form>"
"RTN","SAMIUR2",478,0)
 q nuhref
"RTN","SAMIUR2",479,0)
 ;
"RTN","SAMIUR2",480,0)
CUMPY(PYARY,sid,KEY) ; forms array of cummulative pack year data
"RTN","SAMIUR2",481,0)
 ; PYARY passed by name
"RTN","SAMIUR2",482,0)
 ; KEY is the current form key for matching to a row
"RTN","SAMIUR2",483,0)
 k @PYARY
"RTN","SAMIUR2",484,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIUR2",485,0)
 ;n sid s sid=$g(@root@(DFN,"samistudyid"))
"RTN","SAMIUR2",486,0)
 ;q:sid=""
"RTN","SAMIUR2",487,0)
 n items s items=""
"RTN","SAMIUR2",488,0)
 d GETITEMS^SAMICASE("items",sid)
"RTN","SAMIUR2",489,0)
 q:'$d(items)
"RTN","SAMIUR2",490,0)
 m @PYARY@("items")=items
"RTN","SAMIUR2",491,0)
 n siform
"RTN","SAMIUR2",492,0)
 s siform=$o(items("siform"))
"RTN","SAMIUR2",493,0)
 q:siform=""
"RTN","SAMIUR2",494,0)
 i siform=$g(KEY) s @PYARY@("current")=1 ;this row is the current form
"RTN","SAMIUR2",495,0)
 n vals
"RTN","SAMIUR2",496,0)
 s vals=$na(@root@("graph",sid,siform))
"RTN","SAMIUR2",497,0)
 n kdate s kdate=$$GETDTKEY^SAMICAS2(siform)
"RTN","SAMIUR2",498,0)
 n keydate s keydate=$$KEY2DSPD^SAMICAS2(kdate)
"RTN","SAMIUR2",499,0)
 s @PYARY@("rpt",1,1)="Intake" ; Form
"RTN","SAMIUR2",500,0)
 s @PYARY@("rpt",1,2)=keydate ; Reported Date
"RTN","SAMIUR2",501,0)
 n lastcum s lastcum=$g(@vals@("sippy"))
"RTN","SAMIUR2",502,0)
 s @PYARY@("rpt",1,3)=lastcum ; Pack Years
"RTN","SAMIUR2",503,0)
 s @PYARY@("rpt",1,4)=lastcum ; Cumulative
"RTN","SAMIUR2",504,0)
 n lastdt s lastdt=keydate
"RTN","SAMIUR2",505,0)
 n rptcnt s rptcnt=1
"RTN","SAMIUR2",506,0)
 n zi s zi=""
"RTN","SAMIUR2",507,0)
 f  s zi=$o(items("type","vapals:fuform",zi)) q:zi=""  d  ;
"RTN","SAMIUR2",508,0)
 . s rptcnt=rptcnt+1
"RTN","SAMIUR2",509,0)
 . s @PYARY@("rpt",rptcnt,1)="Follow-up"
"RTN","SAMIUR2",510,0)
 . n kdate s kdate=$$GETDTKEY^SAMICAS2(zi)
"RTN","SAMIUR2",511,0)
 . n keydate s keydate=$$KEY2DSPD^SAMICAS2(kdate)
"RTN","SAMIUR2",512,0)
 . s @PYARY@("rpt",rptcnt,2)=keydate ; Reported Date
"RTN","SAMIUR2",513,0)
 . s vals=$na(@root@("graph",sid,zi))
"RTN","SAMIUR2",514,0)
 . n newpd s newpd=$g(@vals@("sippd"))
"RTN","SAMIUR2",515,0)
 . n usedate,siq s usedate=keydate
"RTN","SAMIUR2",516,0)
 . s siq=$g(@vals@("siq")) ; quit date on followup form
"RTN","SAMIUR2",517,0)
 . i siq'="" d  ; quit date provided
"RTN","SAMIUR2",518,0)
 . . if $$FMDT(siq)<$$FMDT(lastdt) q  ; quit date out of range
"RTN","SAMIUR2",519,0)
 . . if $$FMDT(siq)>$$FMDT(keydate) q  ; quit date out of range
"RTN","SAMIUR2",520,0)
 . . s usedate=siq ; use the quit date as end of range
"RTN","SAMIUR2",521,0)
 . n newpy s newpy=$$PKYDT(lastdt,usedate,newpd)
"RTN","SAMIUR2",522,0)
 . s @vals@("sippy")=newpy
"RTN","SAMIUR2",523,0)
 . s ^gpl("current","KEY")=$g(KEY)
"RTN","SAMIUR2",524,0)
 . s ^gpl("current","zi")=zi
"RTN","SAMIUR2",525,0)
 . i zi=$g(KEY) s @PYARY@("current")=rptcnt ;this row is the current form
"RTN","SAMIUR2",526,0)
 . n newcum s newcum=""
"RTN","SAMIUR2",527,0)
 . i newpy'="" s newcum=lastcum+newpy
"RTN","SAMIUR2",528,0)
 . s @PYARY@("rpt",rptcnt,3)=newpy ; Pack Years
"RTN","SAMIUR2",529,0)
 . s @PYARY@("rpt",rptcnt,4)=newcum ; Cumulative
"RTN","SAMIUR2",530,0)
 . s lastdt=keydate
"RTN","SAMIUR2",531,0)
 . s lastcum=newcum
"RTN","SAMIUR2",532,0)
 q
"RTN","SAMIUR2",533,0)
 ;
"RTN","SAMIUR2",534,0)
EPAT(ien,dfn,SAMIPATS) ; extrinsic the patient name with navigation
"RTN","SAMIUR2",535,0)
 ; to enrollment
"RTN","SAMIUR2",536,0)
 q
"RTN","SAMIUR2",537,0)
 ;
"SEC","^DIC",311.11,311.11,0,"AUDIT")
@
"SEC","^DIC",311.11,311.11,0,"DD")
@
"SEC","^DIC",311.11,311.11,0,"DEL")
@
"SEC","^DIC",311.11,311.11,0,"LAYGO")
@
"SEC","^DIC",311.11,311.11,0,"RD")
@
"SEC","^DIC",311.11,311.11,0,"WR")
@
"SEC","^DIC",311.12,311.12,0,"AUDIT")
@
"SEC","^DIC",311.12,311.12,0,"DD")
@
"SEC","^DIC",311.12,311.12,0,"DEL")
@
"SEC","^DIC",311.12,311.12,0,"LAYGO")
@
"SEC","^DIC",311.12,311.12,0,"RD")
@
"SEC","^DIC",311.12,311.12,0,"WR")
@
"SEC","^DIC",311.13,311.13,0,"AUDIT")
@
"SEC","^DIC",311.13,311.13,0,"DD")
@
"SEC","^DIC",311.13,311.13,0,"DEL")
@
"SEC","^DIC",311.13,311.13,0,"LAYGO")
@
"SEC","^DIC",311.13,311.13,0,"RD")
@
"SEC","^DIC",311.13,311.13,0,"WR")
@
"VER")
8.0^22.2
"^DD",311.11,311.11,0)
FIELD^^2^6
"^DD",311.11,311.11,0,"DT")
3171216
"^DD",311.11,311.11,0,"IX","B",311.11,.01)

"^DD",311.11,311.11,0,"NM","SAMI FORM MAPPING")

"^DD",311.11,311.11,.01,0)
FORM^RF^^0;1^K:$L(X)>30!(X?.N)!($L(X)<3)!'(X'?1P.E) X
"^DD",311.11,311.11,.01,.1)
FORM NAME
"^DD",311.11,311.11,.01,1,0)
^.1
"^DD",311.11,311.11,.01,1,1,0)
311.11^B
"^DD",311.11,311.11,.01,1,1,1)
S ^SAMI(311.11,"B",$E(X,1,30),DA)=""
"^DD",311.11,311.11,.01,1,1,2)
K ^SAMI(311.11,"B",$E(X,1,30),DA)
"^DD",311.11,311.11,.01,3)
NAME MUST BE 3-30 CHARACTERS, NOT NUMERIC OR STARTING WITH PUNCTUATION
"^DD",311.11,311.11,.01,"DT")
3170913
"^DD",311.11,311.11,.02,0)
INDEXED BY^FJ20^^2;1^K:$L(X)>20!($L(X)<1) X
"^DD",311.11,311.11,.02,3)
MUMPS variable to use for lookup and indexing
"^DD",311.11,311.11,.02,21,0)
^^1^1^3170913^
"^DD",311.11,311.11,.02,21,1,0)
MUMPS symbol to use for lookup and indexing ie. studyid or DFN
"^DD",311.11,311.11,.02,"DT")
3170913
"^DD",311.11,311.11,.5,0)
FILEMAN FILE (DEFAULT)^P1'^DIC(^0;2^Q
"^DD",311.11,311.11,.5,.1)
DEFAULT FILEMAN FILE FOR MAPPING
"^DD",311.11,311.11,.5,"DT")
3170913
"^DD",311.11,311.11,.7,0)
GRAPH^P17.040801^%wd(17.040801,^0;3^Q
"^DD",311.11,311.11,.7,.1)
DEFAULT GRAPH FOR INTERMEDIATE STORAGE
"^DD",311.11,311.11,.7,"DT")
3170913
"^DD",311.11,311.11,1,0)
VARIABLE^311.11001A^^1;0
"^DD",311.11,311.11,2,0)
HTML TEMPLATE NAME^FJ90^^2;2^K:$L(X)>90!($L(X)<2) X
"^DD",311.11,311.11,2,3)
Answer must be 2-90 characters in length.
"^DD",311.11,311.11,2,"DT")
3171216
"^DD",311.11,311.11001,0)
VARIABLE SUB-FIELD^^5^8
"^DD",311.11,311.11001,0,"DT")
3170913
"^DD",311.11,311.11001,0,"IX","B",311.11001,.01)

"^DD",311.11,311.11001,0,"NM","VARIABLE")

"^DD",311.11,311.11001,0,"UP")
311.11
"^DD",311.11,311.11001,.01,0)
VARIABLE^MFJ90^^0;1^K:$L(X)>90!($L(X)<1) X
"^DD",311.11,311.11001,.01,1,0)
^.1
"^DD",311.11,311.11001,.01,1,1,0)
311.11001^B
"^DD",311.11,311.11001,.01,1,1,1)
S ^SAMI(311.11,DA(1),1,"B",$E(X,1,30),DA)=""
"^DD",311.11,311.11001,.01,1,1,2)
K ^SAMI(311.11,DA(1),1,"B",$E(X,1,30),DA)
"^DD",311.11,311.11001,.01,3)
Answer must be 1-90 characters in length.
"^DD",311.11,311.11001,.01,"DT")
3170913
"^DD",311.11,311.11001,.02,0)
TITLE^FJ90^^0;4^K:$L(X)>90!($L(X)<1) X
"^DD",311.11,311.11001,.02,3)
Answer must be 1-90 characters in length.
"^DD",311.11,311.11001,.02,21,0)
^^1^1^3170913^
"^DD",311.11,311.11001,.02,21,1,0)
Dictionary title of this variable
"^DD",311.11,311.11001,.02,"DT")
3170913
"^DD",311.11,311.11001,.5,0)
FILEMAN FILE^P1'^DIC(^0;2^Q
"^DD",311.11,311.11001,.5,"DT")
3171115
"^DD",311.11,311.11001,1,0)
FILEMAN FIELD^NJ17,7^^0;3^K:+X'=X!(X>999999999)!(X<0)!(X?.E1"."8N.N) X
"^DD",311.11,311.11001,1,3)
Fileman field number which maps to this variable
"^DD",311.11,311.11001,1,21,0)
^^1^1^3170913^
"^DD",311.11,311.11001,1,21,1,0)
Fileman field number which maps to this variable
"^DD",311.11,311.11001,1,"DT")
3171115
"^DD",311.11,311.11001,2,0)
DATA TYPE^FJ30^^0;5^K:$L(X)>30!($L(X)<1) X
"^DD",311.11,311.11001,2,3)
Dictionary data type of this variable
"^DD",311.11,311.11001,2,21,0)
^^1^1^3170913^
"^DD",311.11,311.11001,2,21,1,0)
Dictionary data type of this variable
"^DD",311.11,311.11001,2,"DT")
3170913
"^DD",311.11,311.11001,3,0)
REQUIRED^S^1:YES;0:NO;^0;6^Q
"^DD",311.11,311.11001,3,3)
Is this variable required?
"^DD",311.11,311.11001,3,21,0)
^^1^1^3170913^
"^DD",311.11,311.11001,3,21,1,0)
Dictionary definition of whether the variable is required
"^DD",311.11,311.11001,3,"DT")
3170913
"^DD",311.11,311.11001,4,0)
ELCAP FIELD NUMBER^NJ13,7^^1;1^K:+X'=X!(X>99999)!(X<0)!(X?.E1"."8N.N) X
"^DD",311.11,311.11001,4,3)
ELCAP field number of this variable, if available
"^DD",311.11,311.11001,4,21,0)
^^2^2^3170913^
"^DD",311.11,311.11001,4,21,1,0)
Dictionary value of the ELCAP field number for this variable. May not be ava
"^DD",311.11,311.11001,4,21,2,0)
May not be available.
"^DD",311.11,311.11001,4,"DT")
3170913
"^DD",311.11,311.11001,5,0)
COMMENTS^FJ90^^1;2^K:$L(X)>90!($L(X)<1) X
"^DD",311.11,311.11001,5,3)
Answer must be 1-90 characters in length.
"^DD",311.11,311.11001,5,21,0)
^^1^1^3170913^
"^DD",311.11,311.11001,5,21,1,0)
Dictionary definition/comments about the variable
"^DD",311.11,311.11001,5,"DT")
3170913
"^DD",311.12,311.12,0)
FIELD^^.03^3
"^DD",311.12,311.12,0,"DT")
3200327
"^DD",311.12,311.12,0,"ID","W.02")
W "   ",$P(^(0),U,2)
"^DD",311.12,311.12,0,"IX","B",311.12,.01)

"^DD",311.12,311.12,0,"NM","SAMI SITE")

"^DD",311.12,311.12,.01,0)
SITE^RP4'^DIC(4,^0;1^Q
"^DD",311.12,311.12,.01,.1)
SAMI SITE
"^DD",311.12,311.12,.01,1,0)
^.1
"^DD",311.12,311.12,.01,1,1,0)
311.12^B
"^DD",311.12,311.12,.01,1,1,1)
S ^SAMI(311.12,"B",$E(X,1,30),DA)=""
"^DD",311.12,311.12,.01,1,1,2)
K ^SAMI(311.12,"B",$E(X,1,30),DA)
"^DD",311.12,311.12,.01,3)
NAME MUST BE 3-30 CHARACTERS, NOT NUMERIC OR STARTING WITH PUNCTUATION
"^DD",311.12,311.12,.01,"DT")
3200325
"^DD",311.12,311.12,.02,0)
SYMBOL^FJ3^^0;2^K:$L(X)>3!($L(X)<1) X
"^DD",311.12,311.12,.02,.1)
SITE SYMBOL
"^DD",311.12,311.12,.02,3)
Answer must be 1-3 characters in length.
"^DD",311.12,311.12,.02,"DT")
3200407
"^DD",311.12,311.12,.03,0)
ACTIVE^St11^^3;3^Q
"^DD",311.12,311.12,.03,.1)
IS THE SITE ACTIVE
"^DD",311.12,311.12,.03,"DT")
3200327
"^DD",311.13,311.13,0)
FIELD^^.02^2
"^DD",311.13,311.13,0,"DT")
3200410
"^DD",311.13,311.13,0,"IX","B",311.13,.01)

"^DD",311.13,311.13,0,"NM","SAMI SUPERUSERS")

"^DD",311.13,311.13,.01,0)
NAME^RP200'^VA(200,^0;1^Q
"^DD",311.13,311.13,.01,.1)
SUPERUSER NAME
"^DD",311.13,311.13,.01,1,0)
^.1
"^DD",311.13,311.13,.01,1,1,0)
311.13^B
"^DD",311.13,311.13,.01,1,1,1)
S ^SAMI(311.13,"B",$E(X,1,30),DA)=""
"^DD",311.13,311.13,.01,1,1,2)
K ^SAMI(311.13,"B",$E(X,1,30),DA)
"^DD",311.13,311.13,.01,3)
NAME MUST BE 3-30 CHARACTERS, NOT NUMERIC OR STARTING WITH PUNCTUATION
"^DD",311.13,311.13,.01,"DT")
3200410
"^DD",311.13,311.13,.02,0)
ACTIVE^St11^^0;2^Q
"^DD",311.13,311.13,.02,.1)
IS ACTIVE YES/NO
"^DD",311.13,311.13,.02,"DT")
3200410
"^DIC",311.11,311.11,0)
SAMI FORM MAPPING^311.11
"^DIC",311.11,311.11,0,"GL")
^SAMI(311.11,
"^DIC",311.11,311.11,"%",0)
^1.005^^0
"^DIC",311.11,311.11,"%D",0)
^^2^2^3170913^
"^DIC",311.11,311.11,"%D",1,0)
This is a form mapping file created by gpl for the VA-PALS project
"^DIC",311.11,311.11,"%D",2,0)
It maps the variable names used in the ELCAP forms to field numbers in fileman files
"^DIC",311.11,"B","SAMI FORM MAPPING",311.11)

"^DIC",311.12,311.12,0)
SAMI SITE^311.12
"^DIC",311.12,311.12,0,"GL")
^SAMI(311.12,
"^DIC",311.12,311.12,"%",0)
^1.005^^
"^DIC",311.12,"B","SAMI SITE",311.12)

"^DIC",311.13,311.13,0)
SAMI SUPERUSERS^311.13
"^DIC",311.13,311.13,0,"GL")
^SAMI(311.13,
"^DIC",311.13,311.13,"%",0)
^1.005^^
"^DIC",311.13,"B","SAMI SUPERUSERS",311.13)

**END**
**END**
