KIDS Distribution saved on Mar 18, 2021@07:44:50
Released SAMI*18.0*9 SEQ #9 (1.18.0.9-i9)
**KIDS**:SAMI*18.0*9^

**INSTALL NAME**
SAMI*18.0*9
"BLD",11504,0)
SAMI*18.0*9^SAMI^0^3210318^n
"BLD",11504,1,0)
^^3^3^3210316^^
"BLD",11504,1,1,0)
Updates to CT Eval form initialization. Copy Nodules from 
"BLD",11504,1,2,0)
last previous CT form
"BLD",11504,1,3,0)
Prefill baseline and previous scans fields
"BLD",11504,4,0)
^9.64PA^^
"BLD",11504,6.3)
5
"BLD",11504,"KRN",0)
^9.67PA^1.5^25
"BLD",11504,"KRN",.4,0)
.4
"BLD",11504,"KRN",.401,0)
.401
"BLD",11504,"KRN",.402,0)
.402
"BLD",11504,"KRN",.403,0)
.403
"BLD",11504,"KRN",.5,0)
.5
"BLD",11504,"KRN",.84,0)
.84
"BLD",11504,"KRN",1.5,0)
1.5
"BLD",11504,"KRN",1.6,0)
1.6
"BLD",11504,"KRN",1.61,0)
1.61
"BLD",11504,"KRN",1.62,0)
1.62
"BLD",11504,"KRN",3.6,0)
3.6
"BLD",11504,"KRN",3.8,0)
3.8
"BLD",11504,"KRN",9.2,0)
9.2
"BLD",11504,"KRN",9.8,0)
9.8
"BLD",11504,"KRN",9.8,"NM",0)
^9.68A^8^8
"BLD",11504,"KRN",9.8,"NM",1,0)
SAMICAS2^^0^B381201104
"BLD",11504,"KRN",9.8,"NM",2,0)
SAMICAS3^^0^B264696209
"BLD",11504,"KRN",9.8,"NM",3,0)
SAMINOT2^^0^B463867017
"BLD",11504,"KRN",9.8,"NM",4,0)
SAMIHOM4^^0^B748595747
"BLD",11504,"KRN",9.8,"NM",5,0)
SAMICUL^^0^B129347
"BLD",11504,"KRN",9.8,"NM",6,0)
SAMIHUL^^0^B95115
"BLD",11504,"KRN",9.8,"NM",7,0)
SAMINUL^^0^B82731
"BLD",11504,"KRN",9.8,"NM",8,0)
SAMIUL^^0^B17740
"BLD",11504,"KRN",9.8,"NM","B","SAMICAS2",1)

"BLD",11504,"KRN",9.8,"NM","B","SAMICAS3",2)

"BLD",11504,"KRN",9.8,"NM","B","SAMICUL",5)

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

"BLD",11504,"KRN",9.8,"NM","B","SAMIHUL",6)

"BLD",11504,"KRN",9.8,"NM","B","SAMINOT2",3)

"BLD",11504,"KRN",9.8,"NM","B","SAMINUL",7)

"BLD",11504,"KRN",9.8,"NM","B","SAMIUL",8)

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

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

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

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

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

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

"BLD",11504,"KRN","B",1.5,1.5)

"BLD",11504,"KRN","B",1.6,1.6)

"BLD",11504,"KRN","B",1.61,1.61)

"BLD",11504,"KRN","B",1.62,1.62)

"BLD",11504,"KRN","B",3.6,3.6)

"BLD",11504,"KRN","B",3.8,3.8)

"BLD",11504,"KRN","B",9.2,9.2)

"BLD",11504,"KRN","B",9.8,9.8)

"BLD",11504,"KRN","B",19,19)

"BLD",11504,"KRN","B",19.1,19.1)

"BLD",11504,"KRN","B",101,101)

"BLD",11504,"KRN","B",409.61,409.61)

"BLD",11504,"KRN","B",771,771)

"BLD",11504,"KRN","B",779.2,779.2)

"BLD",11504,"KRN","B",870,870)

"BLD",11504,"KRN","B",8989.51,8989.51)

"BLD",11504,"KRN","B",8989.52,8989.52)

"BLD",11504,"KRN","B",8993,8993)

"BLD",11504,"KRN","B",8994,8994)

"BLD",11504,"QUES",0)
^9.62^^
"BLD",11504,"REQB",0)
^9.611^5^5
"BLD",11504,"REQB",1,0)
SAMI*18.0*1^1
"BLD",11504,"REQB",2,0)
SAMI*18.0*3^1
"BLD",11504,"REQB",3,0)
SAMI*18.0*4^1
"BLD",11504,"REQB",4,0)
SAMI 18.0T05^1
"BLD",11504,"REQB",5,0)
SAMI*18.0*6^1
"BLD",11504,"REQB","B","SAMI 18.0T05",4)

"BLD",11504,"REQB","B","SAMI*18.0*1",1)

"BLD",11504,"REQB","B","SAMI*18.0*3",2)

"BLD",11504,"REQB","B","SAMI*18.0*4",3)

"BLD",11504,"REQB","B","SAMI*18.0*6",5)

"MBREQ")
0
"PKG",230,-1)
1^1
"PKG",230,0)
SAMI^SAMI^SCREENING APPLICATIONS MANAGEMENT - IELCAP
"PKG",230,22,0)
^9.49I^1^1
"PKG",230,22,1,0)
18.0^3191203
"PKG",230,22,1,"PAH",1,0)
9^3210318^1
"PKG",230,22,1,"PAH",1,1,0)
^^3^3^3210318
"PKG",230,22,1,"PAH",1,1,1,0)
Updates to CT Eval form initialization. Copy Nodules from 
"PKG",230,22,1,"PAH",1,1,2,0)
last previous CT form
"PKG",230,22,1,"PAH",1,1,3,0)
Prefill baseline and previous scans fields
"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")
8
"RTN","SAMICAS2")
0^1^B381201104
"RTN","SAMICAS2",1,0)
SAMICAS2 ;ven/gpl - ielcap: case review page ;2021-03-17T15:09Z
"RTN","SAMICAS2",2,0)
 ;;18.0;SAMI;**1,5,9**;;Build 5
"RTN","SAMICAS2",3,0)
 ;;1.18.0.9-i9
"RTN","SAMICAS2",4,0)
 ;
"RTN","SAMICAS2",5,0)
 ; SAMICAS2 contains ppis and other subroutines to support processing
"RTN","SAMICAS2",6,0)
 ; of the VAPALS case review page.
"RTN","SAMICAS2",7,0)
 ;
"RTN","SAMICAS2",8,0)
 quit  ; no entry from top
"RTN","SAMICAS2",9,0)
 ;
"RTN","SAMICAS2",10,0)
 ;
"RTN","SAMICAS2",11,0)
 ;
"RTN","SAMICAS2",12,0)
 ;@section 0 primary development: see routine %wful
"RTN","SAMICAS2",13,0)
 ;
"RTN","SAMICAS2",14,0)
 ;
"RTN","SAMICAS2",15,0)
 ;
"RTN","SAMICAS2",16,0)
 ;@license: see routine SAMIUL
"RTN","SAMICAS2",17,0)
 ;@documentation : see SAMICUL
"RTN","SAMICAS2",18,0)
 ;@contents
"RTN","SAMICAS2",19,0)
 ; WSCASE: generate case review page
"RTN","SAMICAS2",20,0)
 ; $$NOTEHREF = html for list of notes for form
"RTN","SAMICAS2",21,0)
 ; GETTMPL: return html template
"RTN","SAMICAS2",22,0)
 ; $$CNTITEMS = # forms patient has used before deleting patient
"RTN","SAMICAS2",23,0)
 ; GETITEMS: get items available for studyid
"RTN","SAMICAS2",24,0)
 ; $$GETDTKEY = date part of form key
"RTN","SAMICAS2",25,0)
 ; $$KEY2DSPD = date in elcap format from key date
"RTN","SAMICAS2",26,0)
 ; $$VAPALSDT = vapals format for dates
"RTN","SAMICAS2",27,0)
 ;
"RTN","SAMICAS2",28,0)
 ; WSNUFORM: select a new form for patient (get service)
"RTN","SAMICAS2",29,0)
 ; KEY2FM: convert a key to a fileman date
"RTN","SAMICAS2",30,0)
 ;
"RTN","SAMICAS2",31,0)
 ; $$GSAMISTA = value of 'samistatus' from form
"RTN","SAMICAS2",32,0)
 ; SSAMISTA: sets 'samistatus' to val in form
"RTN","SAMICAS2",33,0)
 ; DELFORM: deletes form if incomplete
"RTN","SAMICAS2",34,0)
 ; INITSTAT: set all forms to 'incomplete'
"RTN","SAMICAS2",35,0)
 ;
"RTN","SAMICAS2",36,0)
 ;
"RTN","SAMICAS2",37,0)
 ;
"RTN","SAMICAS2",38,0)
 ;@section 1 wsCASE & related ppis
"RTN","SAMICAS2",39,0)
 ;
"RTN","SAMICAS2",40,0)
 ;
"RTN","SAMICAS2",41,0)
 ;
"RTN","SAMICAS2",42,0)
 ;@ppi WSCASE^SAMICAS2, generate case review page
"RTN","SAMICAS2",43,0)
WSCASE ; generate case review page
"RTN","SAMICAS2",44,0)
 ;
"RTN","SAMICAS2",45,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMICAS2",46,0)
 ;
"RTN","SAMICAS2",47,0)
 ;ven/gpl;web service;procedure;
"RTN","SAMICAS2",48,0)
 ;@web service
"RTN","SAMICAS2",49,0)
 ; SAMICASE-wsCASE
"RTN","SAMICAS2",50,0)
 ;@called by :
"RTN","SAMICAS2",51,0)
 ; WSCASE^SAMICASE
"RTN","SAMICAS2",52,0)
 ; _wfhform
"RTN","SAMICAS2",53,0)
 ; %wfhform
"RTN","SAMICAS2",54,0)
 ;@calls :
"RTN","SAMICAS2",55,0)
 ; $$setroot^%wd
"RTN","SAMICAS2",56,0)
 ; GETTMPL^SAMICAS2
"RTN","SAMICAS2",57,0)
 ; GETITEMS^SAMICASE
"RTN","SAMICAS2",58,0)
 ; $$SID2NUM^SAMIHOM3
"RTN","SAMICAS2",59,0)
 ; findReplace^%ts
"RTN","SAMICAS2",60,0)
 ; FIXHREF^SAMIFORM
"RTN","SAMICAS2",61,0)
 ; FIXSRC^SAMIFORM
"RTN","SAMICAS2",62,0)
 ; $$GETDTKEY^SAMICAS2
"RTN","SAMICAS2",63,0)
 ; $$KEY2DSPD^SAMICAS2
"RTN","SAMICAS2",64,0)
 ; $$GETLAST5^SAMIFORM
"RTN","SAMICAS2",65,0)
 ; $$GETSSN^SAMIFORM
"RTN","SAMICAS2",66,0)
 ; $$GETNAME^SAMIFORM
"RTN","SAMICAS2",67,0)
 ; $$GSAMISTA^SAMICAS2
"RTN","SAMICAS2",68,0)
 ; D ADDCRLF^VPRJRUT
"RTN","SAMICAS2",69,0)
 ;@input :
"RTN","SAMICAS2",70,0)
 ; .filter =
"RTN","SAMICAS2",71,0)
 ; .filter("studyid")=studyid of the patient
"RTN","SAMICAS2",72,0)
 ;@output :
"RTN","SAMICAS2",73,0)
 ; .rtn
"RTN","SAMICAS2",74,0)
 ;@tests :
"RTN","SAMICAS2",75,0)
 ; SAMIUTS2
"RTN","SAMICAS2",76,0)
 ;
"RTN","SAMICAS2",77,0)
 ;@stanza 2 initialize
"RTN","SAMICAS2",78,0)
 ;
"RTN","SAMICAS2",79,0)
 kill rtn
"RTN","SAMICAS2",80,0)
 ;
"RTN","SAMICAS2",81,0)
 new groot set groot=$$setroot^%wd("vapals-patients") ; root of patient graphs
"RTN","SAMICAS2",82,0)
 ;
"RTN","SAMICAS2",83,0)
 new temp ; html template
"RTN","SAMICAS2",84,0)
 do GETTMPL^SAMICASE("temp","vapals:casereview")
"RTN","SAMICAS2",85,0)
 quit:'$data(temp)
"RTN","SAMICAS2",86,0)
 ;
"RTN","SAMICAS2",87,0)
 new sid set sid=$get(filter("studyid"))
"RTN","SAMICAS2",88,0)
 if sid="" set sid=$get(filter("studyId"))
"RTN","SAMICAS2",89,0)
 if sid="" set sid=$get(filter("fvalue"))
"RTN","SAMICAS2",90,0)
 quit:sid=""
"RTN","SAMICAS2",91,0)
 ;
"RTN","SAMICAS2",92,0)
 new items
"RTN","SAMICAS2",93,0)
 do GETITEMS^SAMICASE("items",sid)
"RTN","SAMICAS2",94,0)
 quit:'$data(items)
"RTN","SAMICAS2",95,0)
 ;
"RTN","SAMICAS2",96,0)
 new gien set gien=$$SID2NUM^SAMIHOM3(sid) ; graph ien
"RTN","SAMICAS2",97,0)
 new name set name=$get(@groot@(gien,"saminame"))
"RTN","SAMICAS2",98,0)
 quit:name=""
"RTN","SAMICAS2",99,0)
 new fname set fname=$piece(name,",",2)
"RTN","SAMICAS2",100,0)
 new lname set lname=$piece(name,",")
"RTN","SAMICAS2",101,0)
 ;
"RTN","SAMICAS2",102,0)
 ;@stanza 3 change resource paths to /see/
"RTN","SAMICAS2",103,0)
 ;
"RTN","SAMICAS2",104,0)
 new cnt set cnt=0
"RTN","SAMICAS2",105,0)
 new zi set zi=0
"RTN","SAMICAS2",106,0)
 ;for  set zi=$order(temp(zi)) quit:+zi=0  quit:temp(zi)["VEP0001"  do  ;
"RTN","SAMICAS2",107,0)
 for  set zi=$order(temp(zi)) quit:+zi=0  quit:temp(zi)["tbody"  do  ;
"RTN","SAMICAS2",108,0)
 . new ln set ln=temp(zi)
"RTN","SAMICAS2",109,0)
 . new touched set touched=0
"RTN","SAMICAS2",110,0)
 . ;
"RTN","SAMICAS2",111,0)
 . if ln["@@SITE@@" do  ; insert site id
"RTN","SAMICAS2",112,0)
 . . n siteid s siteid=$g(filter("siteid"))
"RTN","SAMICAS2",113,0)
 . . i siteid="" s siteid=$g(filter("site"))
"RTN","SAMICAS2",114,0)
 . . q:siteid=""
"RTN","SAMICAS2",115,0)
 . . do findReplace^%ts(.ln,"@@SITE@@",siteid)
"RTN","SAMICAS2",116,0)
 . . s temp(zi)=ln
"RTN","SAMICAS2",117,0)
 . ;
"RTN","SAMICAS2",118,0)
 . if ln["@@SITETITLE@@" do  ; insert site title
"RTN","SAMICAS2",119,0)
 . . n sitetit s sitetit=$g(filter("sitetitle"))
"RTN","SAMICAS2",120,0)
 . . if sitetit="" d  ;
"RTN","SAMICAS2",121,0)
 . . . n tsite s tsite=$g(filter("site"))
"RTN","SAMICAS2",122,0)
 . . . q:tsite=""
"RTN","SAMICAS2",123,0)
 . . . s sitetit=$$SITENM2^SAMISITE(tsite)_" - "_tsite
"RTN","SAMICAS2",124,0)
 . . q:sitetit=""
"RTN","SAMICAS2",125,0)
 . . do findReplace^%ts(.ln,"@@SITETITLE@@",sitetit)
"RTN","SAMICAS2",126,0)
 . . s temp(zi)=ln
"RTN","SAMICAS2",127,0)
 . ;
"RTN","SAMICAS2",128,0)
 . if ln["id" if ln["studyIdMenu" do  ;
"RTN","SAMICAS2",129,0)
 . . set zi=zi+4
"RTN","SAMICAS2",130,0)
 . ;
"RTN","SAMICAS2",131,0)
 . if ln["home.html" do  ;
"RTN","SAMICAS2",132,0)
 . . do findReplace^%ts(.ln,"home.html","/vapals")
"RTN","SAMICAS2",133,0)
 . . set temp(zi)=ln
"RTN","SAMICAS2",134,0)
 . . set touched=1
"RTN","SAMICAS2",135,0)
 . ;
"RTN","SAMICAS2",136,0)
 . if ln["href" if 'touched do  ;
"RTN","SAMICAS2",137,0)
 . . do FIXHREF^SAMIFORM(.ln)
"RTN","SAMICAS2",138,0)
 . . set temp(zi)=ln
"RTN","SAMICAS2",139,0)
 . ;
"RTN","SAMICAS2",140,0)
 . if ln["src" do  ;
"RTN","SAMICAS2",141,0)
 . . do FIXSRC^SAMIFORM(.ln)
"RTN","SAMICAS2",142,0)
 . . set temp(zi)=ln
"RTN","SAMICAS2",143,0)
 . ;
"RTN","SAMICAS2",144,0)
 . if ln["@@ERROR_MESSAGE@@" do  ; insert error message
"RTN","SAMICAS2",145,0)
 . . n zerr s zerr=$g(filter("errorMessage"))
"RTN","SAMICAS2",146,0)
 . . i zerr="" q  ;
"RTN","SAMICAS2",147,0)
 . . do findReplace^%ts(.ln,"@@ERROR_MESSAGE@@",zerr)
"RTN","SAMICAS2",148,0)
 . . s temp(zi)=ln
"RTN","SAMICAS2",149,0)
 . ;
"RTN","SAMICAS2",150,0)
 . set cnt=cnt+1
"RTN","SAMICAS2",151,0)
 . set rtn(cnt)=temp(zi)
"RTN","SAMICAS2",152,0)
 . quit
"RTN","SAMICAS2",153,0)
 ;
"RTN","SAMICAS2",154,0)
 ; ready to insert rows for selection
"RTN","SAMICAS2",155,0)
 ;
"RTN","SAMICAS2",156,0)
 ;@stanza 4 intake form
"RTN","SAMICAS2",157,0)
 ;
"RTN","SAMICAS2",158,0)
 new sikey set sikey=$order(items("sifor"))
"RTN","SAMICAS2",159,0)
 if sikey="" set sikey="siform-2017-12-10"
"RTN","SAMICAS2",160,0)
 new sidate set sidate=$$GETDTKEY(sikey)
"RTN","SAMICAS2",161,0)
 set sikey="vapals:"_sikey
"RTN","SAMICAS2",162,0)
 new sidispdate set sidispdate=$$KEY2DSPD(sidate)
"RTN","SAMICAS2",163,0)
 ;new geturl set geturl="/form?form=vapals:siform&studyid="_sid_"&key="_sikey
"RTN","SAMICAS2",164,0)
 new nuhref set nuhref="<form method=POST action=""/vapals"">"
"RTN","SAMICAS2",165,0)
 set nuhref=nuhref_"<td><input type=hidden name=""samiroute"" value=""nuform"">"
"RTN","SAMICAS2",166,0)
 set nuhref=nuhref_"<input type=hidden name=""studyid"" value="_sid_">"
"RTN","SAMICAS2",167,0)
 set nuhref=nuhref_"<input value=""New Form"" class=""btn label label-warning"" role=""link"" type=""submit""></form></td>"
"RTN","SAMICAS2",168,0)
 ; new intake notes table
"RTN","SAMICAS2",169,0)
 n notehref,form
"RTN","SAMICAS2",170,0)
 set form=$p(sikey,":",2)
"RTN","SAMICAS2",171,0)
 set notehref=$$NOTEHREF^SAMICASE(sid,form) ; table of notes
"RTN","SAMICAS2",172,0)
 set cnt=cnt+1
"RTN","SAMICAS2",173,0)
 ;new facilitycode set facilitycode=$$GETPRFX^SAMIFORM()
"RTN","SAMICAS2",174,0)
 n siteid s siteid=$g(filter("siteid"))
"RTN","SAMICAS2",175,0)
 i siteid="" s siteid=$g(filter("site"))
"RTN","SAMICAS2",176,0)
 new facilitycode set facilitycode=siteid
"RTN","SAMICAS2",177,0)
 new last5 set last5=$$GETLAST5^SAMIFORM(sid)
"RTN","SAMICAS2",178,0)
 new pssn set pssn=$$GETSSN^SAMIFORM(sid)
"RTN","SAMICAS2",179,0)
 new pname set pname=$$GETNAME^SAMIFORM(sid)
"RTN","SAMICAS2",180,0)
 new useid set useid=pssn
"RTN","SAMICAS2",181,0)
 if useid="" set useid=last5
"RTN","SAMICAS2",182,0)
 set rtn(cnt)="<tr><td> "_useid_" </td><td> "_pname_" </td><td> "_facilitycode_" </td><td>"_sidispdate_"</td><td>"_$char(13)
"RTN","SAMICAS2",183,0)
 set cnt=cnt+1
"RTN","SAMICAS2",184,0)
 set rtn(cnt)="<form method=""post"" action=""/vapals"">"
"RTN","SAMICAS2",185,0)
 set cnt=cnt+1
"RTN","SAMICAS2",186,0)
 set rtn(cnt)="<input name=""samiroute"" value=""form"" type=""hidden"">"
"RTN","SAMICAS2",187,0)
 set rtn(cnt)=rtn(cnt)_" <input name=""studyid"" value="""_sid_""" type=""hidden"">"
"RTN","SAMICAS2",188,0)
 set rtn(cnt)=rtn(cnt)_" <input name=""form"" value="""_sikey_""" type=""hidden"">"
"RTN","SAMICAS2",189,0)
 set rtn(cnt)=rtn(cnt)_" <input value=""Intake"" class=""btn btn-link"" role=""link"" type=""submit"">"
"RTN","SAMICAS2",190,0)
 ;
"RTN","SAMICAS2",191,0)
 new samistatus set samistatus=""
"RTN","SAMICAS2",192,0)
 if $$GSAMISTA(sid,sikey)="incomplete" set samistatus="(incomplete)"
"RTN","SAMICAS2",193,0)
 set cnt=cnt+1
"RTN","SAMICAS2",194,0)
 set rtn(cnt)="</form>"_samistatus_notehref_"</td>"_$char(13)
"RTN","SAMICAS2",195,0)
 set cnt=cnt+1
"RTN","SAMICAS2",196,0)
 set rtn(cnt)=nuhref_"</tr>"
"RTN","SAMICAS2",197,0)
 ;
"RTN","SAMICAS2",198,0)
 ;@stanza 6 rest of the forms
"RTN","SAMICAS2",199,0)
 ;
"RTN","SAMICAS2",200,0)
 new zj set zj="" ; each of the rest of the forms
"RTN","SAMICAS2",201,0)
 if $data(items("sort")) do  ; we have more forms
"RTN","SAMICAS2",202,0)
 . for  set zj=$order(items("sort",zj)) quit:zj=""  do  ;
"RTN","SAMICAS2",203,0)
 . . new cdate set cdate=zj
"RTN","SAMICAS2",204,0)
 . . new zk set zk=""
"RTN","SAMICAS2",205,0)
 . . for  set zk=$order(items("sort",cdate,zk)) q:zk=""  do  ;
"RTN","SAMICAS2",206,0)
 . . . new zform set zform=zk
"RTN","SAMICAS2",207,0)
 . . . new zkey set zkey=$order(items("sort",cdate,zform,""))
"RTN","SAMICAS2",208,0)
 . . . new zname set zname=$order(items("sort",cdate,zform,zkey,""))
"RTN","SAMICAS2",209,0)
 . . . new dispdate set dispdate=$$KEY2DSPD(cdate)
"RTN","SAMICAS2",210,0)
 . . . set zform="vapals:"_zkey ; all the new forms are vapals:key
"RTN","SAMICAS2",211,0)
 . . . ;new geturl set geturl="/form?form="_zform_"&studyid="_sid_"&key="_zkey
"RTN","SAMICAS2",212,0)
 . . . set cnt=cnt+1
"RTN","SAMICAS2",213,0)
 . . . ;set rtn(cnt)="<tr><td> "_sid_" </td><td> - </td><td> - </td><td> - </td><td>"_dispdate_"</td><td>"
"RTN","SAMICAS2",214,0)
 . . . set rtn(cnt)="<tr><td> "_useid_" </td><td> - </td><td> - </td><td>"_dispdate_"</td><td>"
"RTN","SAMICAS2",215,0)
 . . . set cnt=cnt+1
"RTN","SAMICAS2",216,0)
 . . . set rtn(cnt)="<form method=""post"" action=""/vapals"">"_$char(13)
"RTN","SAMICAS2",217,0)
 . . . set cnt=cnt+1
"RTN","SAMICAS2",218,0)
 . . . set rtn(cnt)="<input name=""samiroute"" value=""form"" type=""hidden"">"_$char(13)
"RTN","SAMICAS2",219,0)
 . . . set cnt=cnt+1
"RTN","SAMICAS2",220,0)
 . . . set rtn(cnt)=" <input name=""studyid"" value="""_sid_""" type=""hidden"">"_$char(13)
"RTN","SAMICAS2",221,0)
 . . . set cnt=cnt+1
"RTN","SAMICAS2",222,0)
 . . . set rtn(cnt)=" <input name=""form"" value="""_zform_""" type=""hidden"">"_$char(13)
"RTN","SAMICAS2",223,0)
 . . . set cnt=cnt+1
"RTN","SAMICAS2",224,0)
 . . . set rtn(cnt)=" <input value="""_zname_""" class=""btn btn-link"" role=""link"" type=""submit"">"_$char(13)
"RTN","SAMICAS2",225,0)
 . . . ;
"RTN","SAMICAS2",226,0)
 . . . new samistatus set samistatus=""
"RTN","SAMICAS2",227,0)
 . . . if $$GSAMISTA(sid,zform)="incomplete" set samistatus="(incomplete)"
"RTN","SAMICAS2",228,0)
 . . . set cnt=cnt+1
"RTN","SAMICAS2",229,0)
 . . . set rtn(cnt)="</form>"_samistatus_$$NOTEHREF^SAMICASE(sid,zkey)_"</td>"
"RTN","SAMICAS2",230,0)
 . . . set cnt=cnt+1
"RTN","SAMICAS2",231,0)
 . . . if zform["ceform" do  ;
"RTN","SAMICAS2",232,0)
 . . . . new rpthref set rpthref="<form method=POST action=""/vapals"">"
"RTN","SAMICAS2",233,0)
 . . . . set rpthref=rpthref_"<td><input type=hidden name=""samiroute"" value=""ctreport"">"
"RTN","SAMICAS2",234,0)
 . . . . set rpthref=rpthref_"<input type=hidden name=""form"" value="_$p(zform,":",2)_">"
"RTN","SAMICAS2",235,0)
 . . . . set rpthref=rpthref_"<input type=hidden name=""studyid"" value="_sid_">"
"RTN","SAMICAS2",236,0)
 . . . . set rpthref=rpthref_"<input value=""Report"" class=""btn label label-warning"" role=""link"" type=""submit""></form></td>"
"RTN","SAMICAS2",237,0)
 . . . . set rtn(cnt)=rpthref_"</tr>"
"RTN","SAMICAS2",238,0)
 . . . . ;set rtn(cnt)="</tr>" ; turn off report
"RTN","SAMICAS2",239,0)
 . . . else  set rtn(cnt)="<td></td></tr>"
"RTN","SAMICAS2",240,0)
 . . . quit
"RTN","SAMICAS2",241,0)
 . . quit
"RTN","SAMICAS2",242,0)
 . quit
"RTN","SAMICAS2",243,0)
 ;
"RTN","SAMICAS2",244,0)
 ;
"RTN","SAMICAS2",245,0)
 ;@stanza 7 skip ahead in template to tbody
"RTN","SAMICAS2",246,0)
 ;
"RTN","SAMICAS2",247,0)
 new loc set loc=zi+1
"RTN","SAMICAS2",248,0)
 for  set zi=$order(temp(zi)) quit:+zi=0  quit:temp(zi)["/tbody"  do  ;
"RTN","SAMICAS2",249,0)
 . set x=$get(x)
"RTN","SAMICAS2",250,0)
 . quit
"RTN","SAMICAS2",251,0)
 set zi=zi-1
"RTN","SAMICAS2",252,0)
 ;
"RTN","SAMICAS2",253,0)
 ;@stanza 8 rest of lines
"RTN","SAMICAS2",254,0)
 ;
"RTN","SAMICAS2",255,0)
 for  set zi=$order(temp(zi)) quit:+zi=0  do  ;
"RTN","SAMICAS2",256,0)
 . new line
"RTN","SAMICAS2",257,0)
 . set line=temp(zi)
"RTN","SAMICAS2",258,0)
 . ;
"RTN","SAMICAS2",259,0)
 . if line["@@SITE@@" do  ; insert site id
"RTN","SAMICAS2",260,0)
 . . n siteid s siteid=$g(filter("siteid"))
"RTN","SAMICAS2",261,0)
 . . i siteid="" s siteid=$g(filter("site"))
"RTN","SAMICAS2",262,0)
 . . q:siteid=""
"RTN","SAMICAS2",263,0)
 . . do findReplace^%ts(.line,"@@SITE@@",siteid)
"RTN","SAMICAS2",264,0)
 . ;
"RTN","SAMICAS2",265,0)
 . if line["@@SITETITLE@@" do  ; insert site title
"RTN","SAMICAS2",266,0)
 . . n sitetit s sitetit=$g(filter("sitetitle"))
"RTN","SAMICAS2",267,0)
 . . if sitetit="" d  ;
"RTN","SAMICAS2",268,0)
 . . . n tsite s tsite=$g(filter("site"))
"RTN","SAMICAS2",269,0)
 . . . q:tsite=""
"RTN","SAMICAS2",270,0)
 . . . s sitetit=$$SITENM2^SAMISITE(tsite)_" - "_tsite
"RTN","SAMICAS2",271,0)
 . . q:sitetit=""
"RTN","SAMICAS2",272,0)
 . . do findReplace^%ts(.line,"@@SITETITLE@@",sitetit)
"RTN","SAMICAS2",273,0)
 . ;
"RTN","SAMICAS2",274,0)
 . if line["XX0002" do  ;
"RTN","SAMICAS2",275,0)
 . . do findReplace^%ts(.line,"XX0002",sid)
"RTN","SAMICAS2",276,0)
 . ;
"RTN","SAMICAS2",277,0)
 . if line["@@ERROR_MESSAGE@@" do  ;
"RTN","SAMICAS2",278,0)
 . . n zerr
"RTN","SAMICAS2",279,0)
 . . k ^gpl("error")
"RTN","SAMICAS2",280,0)
 . . m ^gpl("error")=filter
"RTN","SAMICAS2",281,0)
 . . s zerr=$g(filter("errorMessage"))
"RTN","SAMICAS2",282,0)
 . . ;i err="" q  ;
"RTN","SAMICAS2",283,0)
 . . s ^gpl("error","zerr")=zerr
"RTN","SAMICAS2",284,0)
 . . do findReplace^%ts(.line,"@@ERROR_MESSAGE@@",zerr)
"RTN","SAMICAS2",285,0)
 . . s ^gpl("error","newline")=line
"RTN","SAMICAS2",286,0)
 . set cnt=cnt+1
"RTN","SAMICAS2",287,0)
 . set rtn(cnt)=line
"RTN","SAMICAS2",288,0)
 . quit
"RTN","SAMICAS2",289,0)
 ;
"RTN","SAMICAS2",290,0)
 do ADDCRLF^VPRJRUT(.rtn)
"RTN","SAMICAS2",291,0)
 set HTTPRSP("mime")="text/html" ; set mime type
"RTN","SAMICAS2",292,0)
 ;
"RTN","SAMICAS2",293,0)
 ;@stanza 9 termination
"RTN","SAMICAS2",294,0)
 ;
"RTN","SAMICAS2",295,0)
 quit  ; end of ppi WSCASE^SAMICAS2
"RTN","SAMICAS2",296,0)
 ;
"RTN","SAMICAS2",297,0)
 ;
"RTN","SAMICAS2",298,0)
 ;
"RTN","SAMICAS2",299,0)
 ;@ppi $$NOTEHREF^SAMICAS2
"RTN","SAMICAS2",300,0)
NOTEHREF ; extrinsic returns html for the list of notes for the form
"RTN","SAMICAS2",301,0)
 ;
"RTN","SAMICAS2",302,0)
 n notehref,ntlist
"RTN","SAMICAS2",303,0)
 s notehref=""
"RTN","SAMICAS2",304,0)
 i form["sifor" d NTLIST^SAMINOT1("ntlist",sid,form)
"RTN","SAMICAS2",305,0)
 i form["fufor" d NTLIST^SAMINOT2("ntlist",sid,form)
"RTN","SAMICAS2",306,0)
 i $o(ntlist(""))="" q notehref
"RTN","SAMICAS2",307,0)
 set notehref="<table>"
"RTN","SAMICAS2",308,0)
 n zi
"RTN","SAMICAS2",309,0)
 s zi=0
"RTN","SAMICAS2",310,0)
 f  s zi=$o(ntlist(zi)) q:+zi=0  d  ;
"RTN","SAMICAS2",311,0)
 . set notehref=notehref_"<td><form method=POST action=""/vapals"">"
"RTN","SAMICAS2",312,0)
 . set notehref=notehref_"<input type=hidden name=""nien"" value="""_$g(ntlist(zi,"nien"))_""">"
"RTN","SAMICAS2",313,0)
 . set notehref=notehref_"<input type=hidden name=""samiroute"" value=""note"">"
"RTN","SAMICAS2",314,0)
 . set notehref=notehref_"<input type=hidden name=""studyid"" value="_sid_">"
"RTN","SAMICAS2",315,0)
 . set notehref=notehref_"<input type=hidden name=""form"" value="_form_">"
"RTN","SAMICAS2",316,0)
 . set notehref=notehref_"<input value="""_$g(ntlist(zi,"name"))_""" class=""btn btn-link"" role=""link"" type=""submit""></form></td></tr>"
"RTN","SAMICAS2",317,0)
 set notehref=notehref_"</table>"
"RTN","SAMICAS2",318,0)
 ;
"RTN","SAMICAS2",319,0)
 q notehref ; end of ppi $$NOTEHREF^SAMICAS2
"RTN","SAMICAS2",320,0)
 ;
"RTN","SAMICAS2",321,0)
 ;
"RTN","SAMICAS2",322,0)
 ;
"RTN","SAMICAS2",323,0)
 ;@ppi GETTMPL^SAMICAS2, get html template
"RTN","SAMICAS2",324,0)
GETTMPL ; get html template
"RTN","SAMICAS2",325,0)
 ;
"RTN","SAMICAS2",326,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMICAS2",327,0)
 ;
"RTN","SAMICAS2",328,0)
 ;ven/gpl;private;procedure;
"RTN","SAMICAS2",329,0)
 ;@called-by
"RTN","SAMICAS2",330,0)
 ; GETTMPL^SAMICASE
"RTN","SAMICAS2",331,0)
 ;@calls
"RTN","SAMICAS2",332,0)
 ; $$getTemplate^%wf
"RTN","SAMICAS2",333,0)
 ; getThis^%wd
"RTN","SAMICAS2",334,0)
 ;@input
"RTN","SAMICAS2",335,0)
 ; return = name of array to return template in
"RTN","SAMICAS2",336,0)
 ; form = name of form
"RTN","SAMICAS2",337,0)
 ;@output
"RTN","SAMICAS2",338,0)
 ; @return = template
"RTN","SAMICAS2",339,0)
 ;@examples [tbd]
"RTN","SAMICAS2",340,0)
 ;@tests [tbd]
"RTN","SAMICAS2",341,0)
 ;
"RTN","SAMICAS2",342,0)
 ;@stanza 2 get html template
"RTN","SAMICAS2",343,0)
 ;
"RTN","SAMICAS2",344,0)
 quit:$get(form)=""
"RTN","SAMICAS2",345,0)
 ;
"RTN","SAMICAS2",346,0)
 new fn set fn=$$getTemplate^%wf(form)
"RTN","SAMICAS2",347,0)
 do getThis^%wd(return,fn)
"RTN","SAMICAS2",348,0)
 ;
"RTN","SAMICAS2",349,0)
 set HTTPRSP("mime")="text/html"
"RTN","SAMICAS2",350,0)
 ;
"RTN","SAMICAS2",351,0)
 ;@stanza 3 termination
"RTN","SAMICAS2",352,0)
 ;
"RTN","SAMICAS2",353,0)
 quit  ; end of ppi GETTMPL^SAMICAS2
"RTN","SAMICAS2",354,0)
 ;
"RTN","SAMICAS2",355,0)
 ;
"RTN","SAMICAS2",356,0)
 ;
"RTN","SAMICAS2",357,0)
CNTITEMS(sid) ; extrinsic returns how many forms the patient has
"RTN","SAMICAS2",358,0)
 ; used before deleting a patient
"RTN","SAMICAS2",359,0)
 ;
"RTN","SAMICAS2",360,0)
 ;@called by : none
"RTN","SAMICAS2",361,0)
 ;@calls :
"RTN","SAMICAS2",362,0)
 ; $$setroot^%wd
"RTN","SAMICAS2",363,0)
 ;@input ;
"RTN","SAMICAS2",364,0)
 ; sid = patient's study ID (e.g. "XXX00001")
"RTN","SAMICAS2",365,0)
 ;@output ;
"RTN","SAMICAS2",366,0)
 ;@tests :
"RTN","SAMICAS2",367,0)
 ; SAMIUTS2
"RTN","SAMICAS2",368,0)
 new groot set groot=$$setroot^%wd("vapals-patients")
"RTN","SAMICAS2",369,0)
 quit:'$data(@groot@("graph",sid)) 0  ; nothing there
"RTN","SAMICAS2",370,0)
 new cnt,zi
"RTN","SAMICAS2",371,0)
 set zi=""
"RTN","SAMICAS2",372,0)
 set cnt=0
"RTN","SAMICAS2",373,0)
 for  set zi=$o(@groot@("graph",sid,zi)) quit:zi=""  do  ;
"RTN","SAMICAS2",374,0)
 . set cnt=cnt+1
"RTN","SAMICAS2",375,0)
 ;
"RTN","SAMICAS2",376,0)
 quit cnt  ; end of CNTITEMS
"RTN","SAMICAS2",377,0)
 ;
"RTN","SAMICAS2",378,0)
 ;
"RTN","SAMICAS2",379,0)
 ;
"RTN","SAMICAS2",380,0)
 ;@ppi GETITEMS^SAMICAS2, get items available for studyid
"RTN","SAMICAS2",381,0)
GETITEMS ; get items available for studyid
"RTN","SAMICAS2",382,0)
 ;
"RTN","SAMICAS2",383,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMICAS2",384,0)
 ;
"RTN","SAMICAS2",385,0)
 ;ven/gpl;private;procedure;
"RTN","SAMICAS2",386,0)
 ;@called by
"RTN","SAMICAS2",387,0)
 ; GETITEMS^SAMICASE
"RTN","SAMICAS2",388,0)
 ;@calls
"RTN","SAMICAS2",389,0)
 ; $$setroot^%wd
"RTN","SAMICAS2",390,0)
 ;@input
"RTN","SAMICAS2",391,0)
 ; @ary = returned items available
"RTN","SAMICAS2",392,0)
 ; sid = patient's study ID (e.g. "XXX00001")
"RTN","SAMICAS2",393,0)
 ;@output
"RTN","SAMICAS2",394,0)
 ;@tests
"RTN","SAMICAS2",395,0)
 ; SAMIUTS2
"RTN","SAMICAS2",396,0)
 ;
"RTN","SAMICAS2",397,0)
 ;@stanza 2 get items
"RTN","SAMICAS2",398,0)
 ;
"RTN","SAMICAS2",399,0)
 new groot set groot=$$setroot^%wd("vapals-patients")
"RTN","SAMICAS2",400,0)
 quit:'$data(@groot@("graph",sid))  ; nothing there
"RTN","SAMICAS2",401,0)
 ;
"RTN","SAMICAS2",402,0)
 kill @ary
"RTN","SAMICAS2",403,0)
 new zi set zi=""
"RTN","SAMICAS2",404,0)
 for  set zi=$order(@groot@("graph",sid,zi)) quit:zi=""  do  ;
"RTN","SAMICAS2",405,0)
 . set @ary@(zi)=""
"RTN","SAMICAS2",406,0)
 . quit
"RTN","SAMICAS2",407,0)
 ;
"RTN","SAMICAS2",408,0)
 ;@stanza 3 get rest of forms (many-to-one, get dates)
"RTN","SAMICAS2",409,0)
 ;
"RTN","SAMICAS2",410,0)
 new tary
"RTN","SAMICAS2",411,0)
 for  set zi=$order(@ary@(zi)) quit:zi=""  do  ;
"RTN","SAMICAS2",412,0)
 . new zkey1,zform set zkey1=$piece(zi,"-",1)
"RTN","SAMICAS2",413,0)
 . ;if zkey1="sbform" quit  ;
"RTN","SAMICAS2",414,0)
 . if zkey1="siform" quit  ;
"RTN","SAMICAS2",415,0)
 . new fname
"RTN","SAMICAS2",416,0)
 . if zkey1="ceform" set fname="CT Evaluation"
"RTN","SAMICAS2",417,0)
 . set zform=zkey1
"RTN","SAMICAS2",418,0)
 . if zkey1="sbform" set zform="vapals:sbform"
"RTN","SAMICAS2",419,0)
 . if zkey1="sbform" set fname="Background"
"RTN","SAMICAS2",420,0)
 . if zkey1="ceform" set zform="vapals:ceform"
"RTN","SAMICAS2",421,0)
 . if zkey1="fuform" set zform="vapals:fuform"
"RTN","SAMICAS2",422,0)
 . if zkey1="fuform" set fname="Follow-up"
"RTN","SAMICAS2",423,0)
 . if zkey1="bxform" set fname="Biopsy"
"RTN","SAMICAS2",424,0)
 . if zkey1="bxform" set zform="vapals:bxform"
"RTN","SAMICAS2",425,0)
 . if zkey1="ptform" set zform="vapals:ptform"
"RTN","SAMICAS2",426,0)
 . if zkey1="ptform" set fname="PET Evaluation"
"RTN","SAMICAS2",427,0)
 . if zkey1="itform" set zform="vapals:itform"
"RTN","SAMICAS2",428,0)
 . if zkey1="itform" set fname="Intervention"
"RTN","SAMICAS2",429,0)
 . if $get(fname)="" set fname="unknown"
"RTN","SAMICAS2",430,0)
 . new zdate set zdate=$extract(zi,$length(zkey1)+2,$length(zi))
"RTN","SAMICAS2",431,0)
 . quit:$get(zdate)=""
"RTN","SAMICAS2",432,0)
 . quit:$get(zform)=""
"RTN","SAMICAS2",433,0)
 . quit:$get(zi)=""
"RTN","SAMICAS2",434,0)
 . quit:$get(fname)=""
"RTN","SAMICAS2",435,0)
 . set tary("sort",zdate,zform,zi,fname)=""
"RTN","SAMICAS2",436,0)
 . set tary("type",zform,zi,fname)=""
"RTN","SAMICAS2",437,0)
 . quit
"RTN","SAMICAS2",438,0)
 merge @ary=tary
"RTN","SAMICAS2",439,0)
 ;
"RTN","SAMICAS2",440,0)
 ;@stanza 4 termination
"RTN","SAMICAS2",441,0)
 ;
"RTN","SAMICAS2",442,0)
 quit  ; end of ppi GETITEMS^SAMICAS2
"RTN","SAMICAS2",443,0)
 ;
"RTN","SAMICAS2",444,0)
 ;
"RTN","SAMICAS2",445,0)
 ;
"RTN","SAMICAS2",446,0)
GETDTKEY(formid) ; date portion of form key
"RTN","SAMICAS2",447,0)
 ;
"RTN","SAMICAS2",448,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMICAS2",449,0)
 ;
"RTN","SAMICAS2",450,0)
 ;ven/gpl;private;function;
"RTN","SAMICAS2",451,0)
 ;@called by
"RTN","SAMICAS2",452,0)
 ;  WSCASE^SAMICAS2
"RTN","SAMICAS2",453,0)
 ;@calls :
"RTN","SAMICAS2",454,0)
 ;@input
"RTN","SAMICAS2",455,0)
 ; formid form key
"RTN","SAMICAS2",456,0)
 ;@output
"RTN","SAMICAS2",457,0)
 ; date from form key
"RTN","SAMICAS2",458,0)
 ;@examples
"RTN","SAMICAS2",459,0)
 ; $$GETDTKEY("sbform-2018-02-26") = "2018-02-26"
"RTN","SAMICAS2",460,0)
 ;@tests :
"RTN","SAMICAS2",461,0)
 ; SAMIUTS2
"RTN","SAMICAS2",462,0)
 ;
"RTN","SAMICAS2",463,0)
 ;@stanza 2 calculate date from key
"RTN","SAMICAS2",464,0)
 ;
"RTN","SAMICAS2",465,0)
 new frm set frm=$piece(formid,"-")
"RTN","SAMICAS2",466,0)
 new date set date=$piece(formid,frm_"-",2)
"RTN","SAMICAS2",467,0)
 ;
"RTN","SAMICAS2",468,0)
 ;@stanza 3 return & termination
"RTN","SAMICAS2",469,0)
 ;
"RTN","SAMICAS2",470,0)
 quit date ; return date; end of $$GETDTKEY
"RTN","SAMICAS2",471,0)
 ;
"RTN","SAMICAS2",472,0)
 ;
"RTN","SAMICAS2",473,0)
 ;
"RTN","SAMICAS2",474,0)
KEY2DSPD(zkey) ; date in elcap format from key date
"RTN","SAMICAS2",475,0)
 ;
"RTN","SAMICAS2",476,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMICAS2",477,0)
 ;
"RTN","SAMICAS2",478,0)
 ;ven/gpl;private;function;
"RTN","SAMICAS2",479,0)
 ;@called by
"RTN","SAMICAS2",480,0)
 ;  WSCASE^SAMICAS2
"RTN","SAMICAS2",481,0)
 ;@calls
"RTN","SAMICAS2",482,0)
 ; ^%DT
"RTN","SAMICAS2",483,0)
 ; $$FMTE^XLFDT
"RTN","SAMICAS2",484,0)
 ; $$VAPALSDT^SAMICAS2
"RTN","SAMICAS2",485,0)
 ;@input
"RTN","SAMICAS2",486,0)
 ; zkey = date in any format %DT can process
"RTN","SAMICAS2",487,0)
 ;@output
"RTN","SAMICAS2",488,0)
 ; date in elcap format
"RTN","SAMICAS2",489,0)
 ;@examples
"RTN","SAMICAS2",490,0)
 ; date 2018-02-26 => 26/Feb/2018
"RTN","SAMICAS2",491,0)
 ;@tests
"RTN","SAMICAS2",492,0)
 ; SAMIUTS2
"RTN","SAMICAS2",493,0)
 ;
"RTN","SAMICAS2",494,0)
 ;@stanza 2 convert date to elcap display format
"RTN","SAMICAS2",495,0)
 ;
"RTN","SAMICAS2",496,0)
 new X set X=zkey
"RTN","SAMICAS2",497,0)
 new Y
"RTN","SAMICAS2",498,0)
 do ^%DT
"RTN","SAMICAS2",499,0)
 ;new Z set Z=$$FMTE^XLFDT(Y,"9D")
"RTN","SAMICAS2",500,0)
 ;set Z=$translate(Z," ","/")
"RTN","SAMICAS2",501,0)
 new zdate
"RTN","SAMICAS2",502,0)
 set zdate=$$VAPALSDT^SAMICASE(Y)
"RTN","SAMICAS2",503,0)
 ;
"RTN","SAMICAS2",504,0)
 ;@stanza 3 return & termination
"RTN","SAMICAS2",505,0)
 ;
"RTN","SAMICAS2",506,0)
 quit zdate  ; return date; end of $$KEY2DSPD
"RTN","SAMICAS2",507,0)
 ;
"RTN","SAMICAS2",508,0)
 ;
"RTN","SAMICAS2",509,0)
 ;
"RTN","SAMICAS2",510,0)
 ;@ppi $$VAPALSDT^SAMICAS2, vapals format for dates
"RTN","SAMICAS2",511,0)
VAPALSDT ; extrinsic which return the vapals format for dates
"RTN","SAMICAS2",512,0)
 ; fmdate is the date in fileman format
"RTN","SAMICAS2",513,0)
 ;
"RTN","SAMICAS2",514,0)
 ;@called by
"RTN","SAMICAS2",515,0)
 ; VAPALSDT^SAMICASE
"RTN","SAMICAS2",516,0)
 ;@calls
"RTN","SAMICAS2",517,0)
 ; $$FMTE^XLFDT
"RTN","SAMICAS2",518,0)
 ;@input
"RTN","SAMICAS2",519,0)
 ; fmdate = date in fileman format
"RTN","SAMICAS2",520,0)
 ;@output
"RTN","SAMICAS2",521,0)
 ; vapals date format
"RTN","SAMICAS2",522,0)
 ;@tests
"RTN","SAMICAS2",523,0)
 ; SAMIUTS2
"RTN","SAMICAS2",524,0)
 ;
"RTN","SAMICAS2",525,0)
 ;new Z set Z=$$FMTE^XLFDT(fmdate,"9D")
"RTN","SAMICAS2",526,0)
 ;set Z=$translate(Z," ","/")
"RTN","SAMICAS2",527,0)
 ;
"RTN","SAMICAS2",528,0)
 new Z set Z=$$FMTE^XLFDT(fmdate,"5D")
"RTN","SAMICAS2",529,0)
 ;
"RTN","SAMICAS2",530,0)
 quit Z ; end of ppi $$VAPALSDT^SAMICAS2
"RTN","SAMICAS2",531,0)
 ;
"RTN","SAMICAS2",532,0)
 ;
"RTN","SAMICAS2",533,0)
 ;
"RTN","SAMICAS2",534,0)
 ;@section 2 WSNUFORM & related ppis
"RTN","SAMICAS2",535,0)
 ;
"RTN","SAMICAS2",536,0)
 ;
"RTN","SAMICAS2",537,0)
 ;
"RTN","SAMICAS2",538,0)
WSNUFORM ; select new form for patient (get service)
"RTN","SAMICAS2",539,0)
 ;
"RTN","SAMICAS2",540,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMICAS2",541,0)
 ;
"RTN","SAMICAS2",542,0)
 ;ven/gpl;web service;procedure;
"RTN","SAMICAS2",543,0)
 ;@called by
"RTN","SAMICAS2",544,0)
 ; WSNUFORM^SAMICASE
"RTN","SAMICAS2",545,0)
 ;@web service
"RTN","SAMICAS2",546,0)
 ;  SAMICASE-wsNuForm
"RTN","SAMICAS2",547,0)
 ;@calls
"RTN","SAMICAS2",548,0)
 ; $$SID2NUM^SAMIHOM3
"RTN","SAMICAS2",549,0)
 ; $$setroot^%wd
"RTN","SAMICAS2",550,0)
 ; GETTMPL^SAMICAS2
"RTN","SAMICAS2",551,0)
 ; findReplace^%ts
"RTN","SAMICAS2",552,0)
 ; FIXHREF^SAMIFORM
"RTN","SAMICAS2",553,0)
 ; FIXSRC^SAMIFORM
"RTN","SAMICAS2",554,0)
 ; findReplace^%ts
"RTN","SAMICAS2",555,0)
 ;@input
"RTN","SAMICAS2",556,0)
 ; .filter =
"RTN","SAMICAS2",557,0)
 ; .filter("studyid")=studyid of the patient
"RTN","SAMICAS2",558,0)
 ;@output
"RTN","SAMICAS2",559,0)
 ; @rtn
"RTN","SAMICAS2",560,0)
 ;@tests
"RTN","SAMICAS2",561,0)
 ; SAMIUTS
"RTN","SAMICAS2",562,0)
 ;
"RTN","SAMICAS2",563,0)
 ;@stanza 2 get select-new-form form
"RTN","SAMICAS2",564,0)
 ;
"RTN","SAMICAS2",565,0)
 new sid set sid=$get(filter("studyid"))
"RTN","SAMICAS2",566,0)
 quit:sid=""
"RTN","SAMICAS2",567,0)
 new sien set sien=$$SID2NUM^SAMIHOM3(sid)
"RTN","SAMICAS2",568,0)
 quit:+sien=0
"RTN","SAMICAS2",569,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMICAS2",570,0)
 new groot set groot=$name(@root@(sien))
"RTN","SAMICAS2",571,0)
 ;
"RTN","SAMICAS2",572,0)
 new saminame set saminame=$get(@groot@("saminame"))
"RTN","SAMICAS2",573,0)
 quit:saminame=""
"RTN","SAMICAS2",574,0)
 ;
"RTN","SAMICAS2",575,0)
 new temp,tout,form
"RTN","SAMICAS2",576,0)
 set return="temp",form="vapals:nuform"
"RTN","SAMICAS2",577,0)
 do GETTMPL
"RTN","SAMICAS2",578,0)
 quit:'$data(temp)
"RTN","SAMICAS2",579,0)
 ;
"RTN","SAMICAS2",580,0)
 new cnt set cnt=0
"RTN","SAMICAS2",581,0)
 new zi set zi=0
"RTN","SAMICAS2",582,0)
 for  set zi=$order(temp(zi)) quit:+zi=0  do  ;
"RTN","SAMICAS2",583,0)
 . new ln set ln=temp(zi)
"RTN","SAMICAS2",584,0)
 . new touched set touched=0
"RTN","SAMICAS2",585,0)
 . ;
"RTN","SAMICAS2",586,0)
 . if ln["href" if 'touched do  ;
"RTN","SAMICAS2",587,0)
 . . do FIXHREF^SAMIFORM(.ln)
"RTN","SAMICAS2",588,0)
 . . set temp(zi)=ln
"RTN","SAMICAS2",589,0)
 . ;
"RTN","SAMICAS2",590,0)
 . if ln["src" d  ;
"RTN","SAMICAS2",591,0)
 . . do FIXSRC^SAMIFORM(.ln)
"RTN","SAMICAS2",592,0)
 . . set temp(zi)=ln
"RTN","SAMICAS2",593,0)
 . ;
"RTN","SAMICAS2",594,0)
 . if ln["@@SID@@" do  ;
"RTN","SAMICAS2",595,0)
 . . do findReplace^%ts(.ln,"@@SID@@",sid)
"RTN","SAMICAS2",596,0)
 . . set temp(zi)=ln
"RTN","SAMICAS2",597,0)
 . . quit
"RTN","SAMICAS2",598,0)
 . ;
"RTN","SAMICAS2",599,0)
 . if ln["@@SITE@@" do  ; insert site id
"RTN","SAMICAS2",600,0)
 . . n siteid s siteid=$g(filter("siteid"))
"RTN","SAMICAS2",601,0)
 . . i siteid="" s siteid=$g(filter("site"))
"RTN","SAMICAS2",602,0)
 . . q:siteid=""
"RTN","SAMICAS2",603,0)
 . . do findReplace^%ts(.ln,"@@SITE@@",siteid)
"RTN","SAMICAS2",604,0)
 . . s temp(zi)=ln
"RTN","SAMICAS2",605,0)
 . ;
"RTN","SAMICAS2",606,0)
 . if ln["@@SITETITLE@@" do  ; insert site title
"RTN","SAMICAS2",607,0)
 . . n sitetit s sitetit=$g(filter("sitetitle"))
"RTN","SAMICAS2",608,0)
 . . if sitetit="" d  ;
"RTN","SAMICAS2",609,0)
 . . . n tsite s tsite=$g(filter("site"))
"RTN","SAMICAS2",610,0)
 . . . q:tsite=""
"RTN","SAMICAS2",611,0)
 . . . s sitetit=$$SITENM2^SAMISITE(tsite)_" - "_tsite
"RTN","SAMICAS2",612,0)
 . . q:sitetit=""
"RTN","SAMICAS2",613,0)
 . . do findReplace^%ts(.ln,"@@SITETITLE@@",sitetit)
"RTN","SAMICAS2",614,0)
 . . s temp(zi)=ln
"RTN","SAMICAS2",615,0)
 . ;
"RTN","SAMICAS2",616,0)
 . set cnt=cnt+1
"RTN","SAMICAS2",617,0)
 . set rtn(cnt)=temp(zi)
"RTN","SAMICAS2",618,0)
 ;
"RTN","SAMICAS2",619,0)
 ;@stanza 3 termination
"RTN","SAMICAS2",620,0)
 ;
"RTN","SAMICAS2",621,0)
 quit  ; end of WSNUFORM
"RTN","SAMICAS2",622,0)
 ;
"RTN","SAMICAS2",623,0)
 ;
"RTN","SAMICAS2",624,0)
 ;
"RTN","SAMICAS2",625,0)
 ;@ppi KEY2FM^SAMICAS2, convert a key to a fileman date
"RTN","SAMICAS2",626,0)
KEY2FM ; convert a key to a fileman date
"RTN","SAMICAS2",627,0)
 ;
"RTN","SAMICAS2",628,0)
 ;@called by
"RTN","SAMICAS2",629,0)
 ; SAVFILTR^SAMISAV
"RTN","SAMICAS2",630,0)
 ; SELECT^SAMIUR1
"RTN","SAMICAS2",631,0)
 ;@calls
"RTN","SAMICAS2",632,0)
 ; ^%DT
"RTN","SAMICAS2",633,0)
 ;@input
"RTN","SAMICAS2",634,0)
 ; key = vapals key (e.g.
"RTN","SAMICAS2",635,0)
 ;@output
"RTN","SAMICAS2",636,0)
 ;@examples
"RTN","SAMICAS2",637,0)
 ;  $$KEY2FM("sbform-2018-02-26") = 3180226
"RTN","SAMICAS2",638,0)
 ;@tests
"RTN","SAMICAS2",639,0)
 ; SAMIUTS2
"RTN","SAMICAS2",640,0)
 ;
"RTN","SAMICAS2",641,0)
 new datepart,X,Y,frm
"RTN","SAMICAS2",642,0)
 set datepart=key
"RTN","SAMICAS2",643,0)
 if $length(key,"-")=4 do  ; allow key to be the whole key ie ceform-2018-10-3
"RTN","SAMICAS2",644,0)
 . set frm=$piece(key,"-",1)
"RTN","SAMICAS2",645,0)
 . set datepart=$piece(key,frm_"-",2)
"RTN","SAMICAS2",646,0)
 set X=datepart
"RTN","SAMICAS2",647,0)
 do ^%DT
"RTN","SAMICAS2",648,0)
 ;
"RTN","SAMICAS2",649,0)
 quit Y ; end of ppi KEY2FM^SAMICAS2
"RTN","SAMICAS2",650,0)
 ;
"RTN","SAMICAS2",651,0)
 ;
"RTN","SAMICAS2",652,0)
 ;
"RTN","SAMICAS2",653,0)
 ;@section 3 casetbl
"RTN","SAMICAS2",654,0)
 ;
"RTN","SAMICAS2",655,0)
 ;
"RTN","SAMICAS2",656,0)
 ;
"RTN","SAMICAS2",657,0)
 ;@ppi $$GSAMISTA^SAMICAS2 = value of 'samistatus' from form
"RTN","SAMICAS2",658,0)
GSAMISTA(sid,form) ; extrinsic returns value of 'samistatus' from form
"RTN","SAMICAS2",659,0)
 ;
"RTN","SAMICAS2",660,0)
 ;@called by
"RTN","SAMICAS2",661,0)
 ; WSCASE^SAMICAS2
"RTN","SAMICAS2",662,0)
 ;@calls
"RTN","SAMICAS2",663,0)
 ; $$setroot^%wd
"RTN","SAMICAS2",664,0)
 ;@input
"RTN","SAMICAS2",665,0)
 ; sid  = patient's studyid
"RTN","SAMICAS2",666,0)
 ; form = specific study form (e.g. "sbform-2018-02-26")
"RTN","SAMICAS2",667,0)
 ;@output
"RTN","SAMICAS2",668,0)
 ; status of the form
"RTN","SAMICAS2",669,0)
 ;@tests
"RTN","SAMICAS2",670,0)
 ; SAMIUTS2
"RTN","SAMICAS2",671,0)
 ;
"RTN","SAMICAS2",672,0)
 new stat,root,useform
"RTN","SAMICAS2",673,0)
 set root=$$setroot^%wd("vapals-patients")
"RTN","SAMICAS2",674,0)
 set useform=form
"RTN","SAMICAS2",675,0)
 if form["vapals:" set useform=$p(form,"vapals:",2)
"RTN","SAMICAS2",676,0)
 set stat=$get(@root@("graph",sid,useform,"samistatus"))
"RTN","SAMICAS2",677,0)
 ;
"RTN","SAMICAS2",678,0)
 quit stat ; end of ppi $$GSAMISTA^SAMICAS2
"RTN","SAMICAS2",679,0)
 ;
"RTN","SAMICAS2",680,0)
 ;
"RTN","SAMICAS2",681,0)
 ;
"RTN","SAMICAS2",682,0)
 ;@ppi SSAMISTA^SAMICAS2, sets 'samistatus' to val in form
"RTN","SAMICAS2",683,0)
SSAMISTA ; sets 'samistatus' to val in form
"RTN","SAMICAS2",684,0)
 ;
"RTN","SAMICAS2",685,0)
 ;@called by
"RTN","SAMICAS2",686,0)
 ; SSAMISTA^SAMICASE
"RTN","SAMICAS2",687,0)
 ;@calls
"RTN","SAMICAS2",688,0)
 ; $$setroot^%wd
"RTN","SAMICAS2",689,0)
 ;@input
"RTN","SAMICAS2",690,0)
 ; sid   = patient's studyid
"RTN","SAMICAS2",691,0)
 ; form  = specific study form (e.g. "sbform-2018-02-26")
"RTN","SAMICAS2",692,0)
 ; value = status (complete, incomplete)
"RTN","SAMICAS2",693,0)
 ;@output
"RTN","SAMICAS2",694,0)
 ; sets 'samistatus' to val in form
"RTN","SAMICAS2",695,0)
 ;@tests
"RTN","SAMICAS2",696,0)
 ;
"RTN","SAMICAS2",697,0)
 new root,useform
"RTN","SAMICAS2",698,0)
 set root=$$setroot^%wd("vapals-patients")
"RTN","SAMICAS2",699,0)
 set useform=form
"RTN","SAMICAS2",700,0)
 if form["vapals:" set useform=$piece(form,"vapals:",2)
"RTN","SAMICAS2",701,0)
 if '$d(@root@("graph",sid,useform)) quit  ; no form there
"RTN","SAMICAS2",702,0)
 set @root@("graph",sid,useform,"samistatus")=val
"RTN","SAMICAS2",703,0)
 ;
"RTN","SAMICAS2",704,0)
 quit  ; end of ppi SSAMISTA^SAMICAS2
"RTN","SAMICAS2",705,0)
 ;
"RTN","SAMICAS2",706,0)
 ;
"RTN","SAMICAS2",707,0)
 ;
"RTN","SAMICAS2",708,0)
 ;@ppi DELFORM^SAMICAS2 - deletes incomplete form
"RTN","SAMICAS2",709,0)
DELFORM ; deletes form if incomplete
"RTN","SAMICAS2",710,0)
 ; will not delete intake or background forms
"RTN","SAMICAS2",711,0)
 ;
"RTN","SAMICAS2",712,0)
 ;@called by
"RTN","SAMICAS2",713,0)
 ; DELFORM^SAMICASE
"RTN","SAMICAS2",714,0)
 ;@calls
"RTN","SAMICAS2",715,0)
 ; $$setroot^%wd
"RTN","SAMICAS2",716,0)
 ; $$GSAMISTA^SAMICAS2
"RTN","SAMICAS2",717,0)
 ; WSCASE^SAMICAS2
"RTN","SAMICAS2",718,0)
 ;@input
"RTN","SAMICAS2",719,0)
 ; .ARGS=
"RTN","SAMICAS2",720,0)
 ; .ARGS("studyid")
"RTN","SAMICAS2",721,0)
 ; .ARGS("form")
"RTN","SAMICAS2",722,0)
 ;@output
"RTN","SAMICAS2",723,0)
 ; @RESULT
"RTN","SAMICAS2",724,0)
 ;@tests
"RTN","SAMICAS2",725,0)
 ; SAMIUTS2
"RTN","SAMICAS2",726,0)
 ;
"RTN","SAMICAS2",727,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMICAS2",728,0)
 new sid,form
"RTN","SAMICAS2",729,0)
 set sid=$get(ARGS("studyid"))
"RTN","SAMICAS2",730,0)
 quit:sid=""
"RTN","SAMICAS2",731,0)
 set form=$get(ARGS("form"))
"RTN","SAMICAS2",732,0)
 quit:form=""
"RTN","SAMICAS2",733,0)
 if form["siform" quit  ;
"RTN","SAMICAS2",734,0)
 ;if '$data(@root@("graph",sid,form)) quit  ; form does not exist
"RTN","SAMICAS2",735,0)
 if $$GSAMISTA(sid,form)="incomplete" do  ;
"RTN","SAMICAS2",736,0)
 . kill @root@("graph",sid,form)
"RTN","SAMICAS2",737,0)
 kill ARGS("samiroute")
"RTN","SAMICAS2",738,0)
 do WSCASE^SAMICASE(.RESULT,.ARGS)
"RTN","SAMICAS2",739,0)
 ;
"RTN","SAMICAS2",740,0)
 quit  ; end of ppi DELFORM^SAMICAS2
"RTN","SAMICAS2",741,0)
 ;
"RTN","SAMICAS2",742,0)
 ;
"RTN","SAMICAS2",743,0)
 ;
"RTN","SAMICAS2",744,0)
INITSTAT ; set all forms to 'incomplete'
"RTN","SAMICAS2",745,0)
 ;
"RTN","SAMICAS2",746,0)
 ;@called by : none
"RTN","SAMICAS2",747,0)
 ;@calls
"RTN","SAMICAS2",748,0)
 ; SSAMISTA^SAMICASE
"RTN","SAMICAS2",749,0)
 ;@input : none
"RTN","SAMICAS2",750,0)
 ;@output
"RTN","SAMICAS2",751,0)
 ; set all forms to 'incomplete'
"RTN","SAMICAS2",752,0)
 ;@tests
"RTN","SAMICAS2",753,0)
 ;
"RTN","SAMICAS2",754,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMICAS2",755,0)
 new zi,zj set (zi,zj)=""
"RTN","SAMICAS2",756,0)
 for  set zi=$order(@root@("graph",zi)) quit:zi=""  do  ;
"RTN","SAMICAS2",757,0)
 . for  set zj=$order(@root@("graph",zi,zj)) quit:zj=""  do  ;
"RTN","SAMICAS2",758,0)
 . . if zj["siform" do SSAMISTA^SAMICASE(zi,zj,"complete") quit  ;
"RTN","SAMICAS2",759,0)
 . . do SSAMISTA^SAMICASE(zi,zj,"incomplete")
"RTN","SAMICAS2",760,0)
 ;
"RTN","SAMICAS2",761,0)
 quit  ; end of INITSTAT
"RTN","SAMICAS2",762,0)
 ;
"RTN","SAMICAS2",763,0)
 ;
"RTN","SAMICAS2",764,0)
 ;
"RTN","SAMICAS2",765,0)
EOR ; end of routine SAMICAS2
"RTN","SAMICAS3")
0^2^B264696209
"RTN","SAMICAS3",1,0)
SAMICAS3 ;ven/gpl - ielcap: case review page (cont) ;2021-03-17T18:31Z
"RTN","SAMICAS3",2,0)
 ;;18.0;SAMI;**3,9**;;Build 5
"RTN","SAMICAS3",3,0)
 ;;1.18.0.9-i9
"RTN","SAMICAS3",4,0)
 ;
"RTN","SAMICAS3",5,0)
 ; SAMICAS3 contains ppis and other subroutines to support processing
"RTN","SAMICAS3",6,0)
 ; of the VAPALS case review page.
"RTN","SAMICAS3",7,0)
 ;
"RTN","SAMICAS3",8,0)
 quit  ; no entry from top
"RTN","SAMICAS3",9,0)
 ;
"RTN","SAMICAS3",10,0)
 ;
"RTN","SAMICAS3",11,0)
 ;
"RTN","SAMICAS3",12,0)
 ;@section 0 primary development: see routine %wful
"RTN","SAMICAS3",13,0)
 ;
"RTN","SAMICAS3",14,0)
 ;
"RTN","SAMICAS3",15,0)
 ;
"RTN","SAMICAS3",16,0)
 ;@license: see routine SAMIUL
"RTN","SAMICAS3",17,0)
 ;@documentation : see SAMICUL
"RTN","SAMICAS3",18,0)
 ;@contents
"RTN","SAMICAS3",19,0)
 ; WSNFPOST: post new form selection (post service)
"RTN","SAMICAS3",20,0)
 ; MKSBFORM: create background form
"RTN","SAMICAS3",21,0)
 ; $$PREVNOD = key of latest form including nodule grid
"RTN","SAMICAS3",22,0)
 ; $$LASTCMP = date & key of last comparison scan
"RTN","SAMICAS3",23,0)
 ; $$PRIORCMP = dates of all scans before last comparison scan
"RTN","SAMICAS3",24,0)
 ; SORTFRMS: sorts all forms for patient sid by date
"RTN","SAMICAS3",25,0)
 ; MKCEFORM: create ct evaluation form
"RTN","SAMICAS3",26,0)
 ; MKFUFORM: create follow-up form
"RTN","SAMICAS3",27,0)
 ; $$BASELNDT = last previous baseline ct date
"RTN","SAMICAS3",28,0)
 ; MKPTFORM: create pet evaluation form
"RTN","SAMICAS3",29,0)
 ; MKITFORM: create intervention form
"RTN","SAMICAS3",30,0)
 ; MKBXFORM: create biopsy form
"RTN","SAMICAS3",31,0)
 ; CASETBL: generates case review table
"RTN","SAMICAS3",32,0)
 ;
"RTN","SAMICAS3",33,0)
 ;
"RTN","SAMICAS3",34,0)
 ;
"RTN","SAMICAS3",35,0)
 ;@section 1 WSNFPOST & related subroutines
"RTN","SAMICAS3",36,0)
 ;
"RTN","SAMICAS3",37,0)
 ;
"RTN","SAMICAS3",38,0)
 ;
"RTN","SAMICAS3",39,0)
 ;;@ppi WSNFPOST^SAMICAS3, post new form selection (post service)
"RTN","SAMICAS3",40,0)
WSNFPOST ; post new form selection (post service)
"RTN","SAMICAS3",41,0)
 ;
"RTN","SAMICAS3",42,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMICAS3",43,0)
 ;
"RTN","SAMICAS3",44,0)
 ;ven/gpl;web service;procedure;
"RTN","SAMICAS3",45,0)
 ;@web service
"RTN","SAMICAS3",46,0)
 ; web service SAMICASE-wsNuFormPost
"RTN","SAMICAS3",47,0)
 ;@called by
"RTN","SAMICAS3",48,0)
 ; WSNFPOST^SAMICASE
"RTN","SAMICAS3",49,0)
 ;@calls
"RTN","SAMICAS3",50,0)
 ; parseBody^%wf
"RTN","SAMICAS3",51,0)
 ; GETHOME^SAMIHOM3
"RTN","SAMICAS3",52,0)
 ; $$KEYDATE^SAMIHOM3
"RTN","SAMICAS3",53,0)
 ; $$setroot^%wd
"RTN","SAMICAS3",54,0)
 ; $$KEY2FM^SAMICAS2
"RTN","SAMICAS3",55,0)
 ; MKSBFORM^SAMICAS3
"RTN","SAMICAS3",56,0)
 ; MKCEFORM^SAMICAS3
"RTN","SAMICAS3",57,0)
 ; MKFUFORM^SAMICAS3
"RTN","SAMICAS3",58,0)
 ; MKBXFORM^SAMICAS3
"RTN","SAMICAS3",59,0)
 ; MKPTFORM^SAMICAS3
"RTN","SAMICAS3",60,0)
 ; MKITFORM^SAMICAS3
"RTN","SAMICAS3",61,0)
 ;@input
"RTN","SAMICAS3",62,0)
 ; .ARGS
"RTN","SAMICAS3",63,0)
 ; .ARGS("form")
"RTN","SAMICAS3",64,0)
 ; .ARGS("studyid")
"RTN","SAMICAS3",65,0)
 ; .ARGS("sid")
"RTN","SAMICAS3",66,0)
 ; .BODY
"RTN","SAMICAS3",67,0)
 ; .BODY(1) (e.g. "samiroute=casereview&dfn="_dfn_"&studyid="_studyid)
"RTN","SAMICAS3",68,0)
 ;@output
"RTN","SAMICAS3",69,0)
 ; @RESULT
"RTN","SAMICAS3",70,0)
 ;@tests
"RTN","SAMICAS3",71,0)
 ; SAMIUTS2
"RTN","SAMICAS3",72,0)
 ;
"RTN","SAMICAS3",73,0)
 ;@stanza 2 get new form
"RTN","SAMICAS3",74,0)
 ;
"RTN","SAMICAS3",75,0)
 new vars,bdy
"RTN","SAMICAS3",76,0)
 set bdy=$get(BODY(1))
"RTN","SAMICAS3",77,0)
 do parseBody^%wf("vars",.bdy)
"RTN","SAMICAS3",78,0)
 merge vars=ARGS
"RTN","SAMICAS3",79,0)
 merge ^SAMIUL("nuform","vars")=vars
"RTN","SAMICAS3",80,0)
 ;
"RTN","SAMICAS3",81,0)
 new sid set sid=$get(vars("studyid"))
"RTN","SAMICAS3",82,0)
 if sid="" set sid=$get(ARGS("sid"))
"RTN","SAMICAS3",83,0)
 if sid="" do  quit  ;
"RTN","SAMICAS3",84,0)
 . do GETHOME^SAMIHOM3(.RESULT,.ARGS) ; on error return to home page
"RTN","SAMICAS3",85,0)
 . quit
"RTN","SAMICAS3",86,0)
 ;
"RTN","SAMICAS3",87,0)
 set nuform=$get(vars("form"))
"RTN","SAMICAS3",88,0)
 if nuform="" set nuform="ceform"
"RTN","SAMICAS3",89,0)
 ;
"RTN","SAMICAS3",90,0)
 new datekey set datekey=$$KEYDATE^SAMIHOM3($$NOW^XLFDT)
"RTN","SAMICAS3",91,0)
 ;
"RTN","SAMICAS3",92,0)
 ; check to see if form already exists
"RTN","SAMICAS3",93,0)
 ;
"RTN","SAMICAS3",94,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMICAS3",95,0)
 n collide s collide=0 ; duplicate form for today - backdate forms scenario
"RTN","SAMICAS3",96,0)
 if $data(@root@("graph",sid,nuform_"-"_datekey)) do  ; already exists
"RTN","SAMICAS3",97,0)
 . s collide=1
"RTN","SAMICAS3",98,0)
 . if nuform="siform" quit
"RTN","SAMICAS3",99,0)
 . if nuform="sbform" quit  ; do not create multiple background forms
"RTN","SAMICAS3",100,0)
 . new lastone
"RTN","SAMICAS3",101,0)
 . set lastone=$order(@root@("graph",sid,nuform_"-a  "),-1)
"RTN","SAMICAS3",102,0)
 . quit:lastone=""
"RTN","SAMICAS3",103,0)
 . set newfm=$$KEY2FM^SAMICASE(lastone)
"RTN","SAMICAS3",104,0)
 . set datekey=$$KEYDATE^SAMIHOM3($$FMADD^XLFDT(newfm,1)) ; add one day to the last form
"RTN","SAMICAS3",105,0)
 ;
"RTN","SAMICAS3",106,0)
 ; code to not allow two same forms for a patient a day
"RTN","SAMICAS3",107,0)
 ;
"RTN","SAMICAS3",108,0)
 i collide=1 d  q  ;
"RTN","SAMICAS3",109,0)
 . s ARGS("errorMessage")="Form already exists for today"
"RTN","SAMICAS3",110,0)
 . s ARGS("studyid")=sid
"RTN","SAMICAS3",111,0)
 . d WSCASE^SAMICASE(.RESULT,.ARGS)
"RTN","SAMICAS3",112,0)
 ;
"RTN","SAMICAS3",113,0)
 if nuform="sbform" do  ;
"RTN","SAMICAS3",114,0)
 . new oldkey s oldkey=$o(@root@("graph",sid,"sbform"))
"RTN","SAMICAS3",115,0)
 . i $e(oldkey,1,6)="sbform" d  q  ;
"RTN","SAMICAS3",116,0)
 . . set ARGS("key")=oldkey
"RTN","SAMICAS3",117,0)
 . . set ARGS("studyid")=sid
"RTN","SAMICAS3",118,0)
 . . set ARGS("form")="vapals:sbform"
"RTN","SAMICAS3",119,0)
 . new key set key="sbform-"_datekey
"RTN","SAMICAS3",120,0)
 . set ARGS("key")=key
"RTN","SAMICAS3",121,0)
 . set ARGS("studyid")=sid
"RTN","SAMICAS3",122,0)
 . set ARGS("form")="vapals:sbform"
"RTN","SAMICAS3",123,0)
 . do MKSBFORM(sid,key)
"RTN","SAMICAS3",124,0)
 . quit
"RTN","SAMICAS3",125,0)
 ;
"RTN","SAMICAS3",126,0)
 if nuform="ceform" do  ;
"RTN","SAMICAS3",127,0)
 . new key set key="ceform-"_datekey
"RTN","SAMICAS3",128,0)
 . set ARGS("key")=key
"RTN","SAMICAS3",129,0)
 . set ARGS("studyid")=sid
"RTN","SAMICAS3",130,0)
 . set ARGS("form")="vapals:ceform"
"RTN","SAMICAS3",131,0)
 . do MKCEFORM(sid,key)
"RTN","SAMICAS3",132,0)
 . quit
"RTN","SAMICAS3",133,0)
 ;
"RTN","SAMICAS3",134,0)
 if nuform="fuform" do  ;
"RTN","SAMICAS3",135,0)
 . new key set key="fuform-"_datekey
"RTN","SAMICAS3",136,0)
 . set ARGS("key")=key
"RTN","SAMICAS3",137,0)
 . set ARGS("studyid")=sid
"RTN","SAMICAS3",138,0)
 . set ARGS("form")="vapals:fuform"
"RTN","SAMICAS3",139,0)
 . do MKFUFORM(sid,key)
"RTN","SAMICAS3",140,0)
 . quit
"RTN","SAMICAS3",141,0)
 ;
"RTN","SAMICAS3",142,0)
 if nuform="bxform" do  ;
"RTN","SAMICAS3",143,0)
 . new key set key="bxform-"_datekey
"RTN","SAMICAS3",144,0)
 . set ARGS("key")=key
"RTN","SAMICAS3",145,0)
 . set ARGS("studyid")=sid
"RTN","SAMICAS3",146,0)
 . set ARGS("form")="vapals:bxform"
"RTN","SAMICAS3",147,0)
 . do MKBXFORM(sid,key)
"RTN","SAMICAS3",148,0)
 . quit
"RTN","SAMICAS3",149,0)
 ;
"RTN","SAMICAS3",150,0)
 if nuform="ptform" do  ;
"RTN","SAMICAS3",151,0)
 . new key set key="ptform-"_datekey
"RTN","SAMICAS3",152,0)
 . set ARGS("key")=key
"RTN","SAMICAS3",153,0)
 . set ARGS("studyid")=sid
"RTN","SAMICAS3",154,0)
 . set ARGS("form")="vapals:ptform"
"RTN","SAMICAS3",155,0)
 . do MKPTFORM(sid,key)
"RTN","SAMICAS3",156,0)
 . quit
"RTN","SAMICAS3",157,0)
 ;
"RTN","SAMICAS3",158,0)
 if nuform="itform" do  ;
"RTN","SAMICAS3",159,0)
 . new key set key="itform-"_datekey
"RTN","SAMICAS3",160,0)
 . set ARGS("key")=key
"RTN","SAMICAS3",161,0)
 . set ARGS("studyid")=sid
"RTN","SAMICAS3",162,0)
 . set ARGS("form")="vapals:itform"
"RTN","SAMICAS3",163,0)
 . do MKITFORM(sid,key)
"RTN","SAMICAS3",164,0)
 . quit
"RTN","SAMICAS3",165,0)
 ;
"RTN","SAMICAS3",166,0)
 do wsGetForm^%wf(.RESULT,.ARGS)
"RTN","SAMICAS3",167,0)
 ;
"RTN","SAMICAS3",168,0)
 ;@stanza 3 termination
"RTN","SAMICAS3",169,0)
 ;
"RTN","SAMICAS3",170,0)
 quit  ; end of ppi WSNFPOST^SAMICAS3
"RTN","SAMICAS3",171,0)
 ;
"RTN","SAMICAS3",172,0)
 ;
"RTN","SAMICAS3",173,0)
 ;
"RTN","SAMICAS3",174,0)
MKSBFORM(sid,key) ; create background form
"RTN","SAMICAS3",175,0)
 ;
"RTN","SAMICAS3",176,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMICAS3",177,0)
 ;
"RTN","SAMICAS3",178,0)
 ;ven/gpl;private;procedure;
"RTN","SAMICAS3",179,0)
 ;@called-by
"RTN","SAMICAS3",180,0)
 ; WSNFPOST^SAMICAS3
"RTN","SAMICAS3",181,0)
 ;@calls
"RTN","SAMICAS3",182,0)
 ; $$setroot^%wd
"RTN","SAMICAS3",183,0)
 ; $$SID2NUM^SAMIHOM3
"RTN","SAMICAS3",184,0)
 ;@input
"RTN","SAMICAS3",185,0)
 ; sid = study id
"RTN","SAMICAS3",186,0)
 ; key =
"RTN","SAMICAS3",187,0)
 ;@output
"RTN","SAMICAS3",188,0)
 ; @root@("graph",sid,key)
"RTN","SAMICAS3",189,0)
 ;@examples [tbd]
"RTN","SAMICAS3",190,0)
 ;@tests [tbd]
"RTN","SAMICAS3",191,0)
 ;
"RTN","SAMICAS3",192,0)
 ;@stanza 2 create background form
"RTN","SAMICAS3",193,0)
 ;
"RTN","SAMICAS3",194,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMICAS3",195,0)
 new sien set sien=$$SID2NUM^SAMIHOM3(sid)
"RTN","SAMICAS3",196,0)
 quit:+sien=0
"RTN","SAMICAS3",197,0)
 new cdate set cdate=$piece(key,"sbform-",2)
"RTN","SAMICAS3",198,0)
 merge @root@("graph",sid,key)=@root@(sien)
"RTN","SAMICAS3",199,0)
 set @root@("graph",sid,key,"samicreatedate")=cdate
"RTN","SAMICAS3",200,0)
 do SSAMISTA^SAMICASE(sid,key,"incomplete")
"RTN","SAMICAS3",201,0)
 ;
"RTN","SAMICAS3",202,0)
 ;@stanza 3 termination
"RTN","SAMICAS3",203,0)
 ;
"RTN","SAMICAS3",204,0)
 quit  ; end of MKSBFORM
"RTN","SAMICAS3",205,0)
 ;
"RTN","SAMICAS3",206,0)
 ;
"RTN","SAMICAS3",207,0)
 ;
"RTN","SAMICAS3",208,0)
PREVNOD(sid) ; key of latest form including nodule grid
"RTN","SAMICAS3",209,0)
 ;
"RTN","SAMICAS3",210,0)
 ; used for nodule copy
"RTN","SAMICAS3",211,0)
 ;
"RTN","SAMICAS3",212,0)
 n retkey s retkey=""
"RTN","SAMICAS3",213,0)
 n fary
"RTN","SAMICAS3",214,0)
 d SORTFRMS(.fary,sid)
"RTN","SAMICAS3",215,0)
 n tdt s tdt=""
"RTN","SAMICAS3",216,0)
 f  s tdt=$o(fary(tdt),-1) q:tdt=""  q:retkey'=""  d  ; 
"RTN","SAMICAS3",217,0)
 . n tmpkey s tmpkey=""
"RTN","SAMICAS3",218,0)
 . f  s tmpkey=$o(fary(tdt,tmpkey)) q:tmpkey=""  q:retkey'=""  d  ; 
"RTN","SAMICAS3",219,0)
 . . i tmpkey["ceform" s retkey=tmpkey
"RTN","SAMICAS3",220,0)
 . . i tmpkey["ptform" s retkey=tmpkey
"RTN","SAMICAS3",221,0)
 . . i tmpkey["bxform" s retkey=tmpkey
"RTN","SAMICAS3",222,0)
 ;
"RTN","SAMICAS3",223,0)
 q retkey ; end of $$PREVNOD
"RTN","SAMICAS3",224,0)
 ;
"RTN","SAMICAS3",225,0)
 ;
"RTN","SAMICAS3",226,0)
 ;
"RTN","SAMICAS3",227,0)
LASTCMP(sid,retkey) ; date & key of last comparison scan
"RTN","SAMICAS3",228,0)
 ;
"RTN","SAMICAS3",229,0)
 ; passed by reference
"RTN","SAMICAS3",230,0)
 ;
"RTN","SAMICAS3",231,0)
 s retkey=""
"RTN","SAMICAS3",232,0)
 n fary
"RTN","SAMICAS3",233,0)
 d SORTFRMS(.fary,sid)
"RTN","SAMICAS3",234,0)
 n tdt s tdt=$P($$NOW^XLFDT,".",1) ; start with before today
"RTN","SAMICAS3",235,0)
 f  s tdt=$o(fary(tdt),-1) q:tdt=""  q:retkey'=""  d  ; 
"RTN","SAMICAS3",236,0)
 . n tmpkey s tmpkey=""
"RTN","SAMICAS3",237,0)
 . f  s tmpkey=$o(fary(tdt,tmpkey)) q:tmpkey=""  q:retkey'=""  d  ; 
"RTN","SAMICAS3",238,0)
 . . i tmpkey["ceform" s retkey=tmpkey
"RTN","SAMICAS3",239,0)
 ;
"RTN","SAMICAS3",240,0)
 n retdt s retdt=-1
"RTN","SAMICAS3",241,0)
 i retkey'="" d  ;
"RTN","SAMICAS3",242,0)
 . n fmdt
"RTN","SAMICAS3",243,0)
 . s fmdt=$$KEY2FM^SAMICASE(retkey)
"RTN","SAMICAS3",244,0)
 . s retdt=$$VAPALSDT^SAMICASE(fmdt)
"RTN","SAMICAS3",245,0)
 ;
"RTN","SAMICAS3",246,0)
 q retdt ; end of $$LASTCMP
"RTN","SAMICAS3",247,0)
 ;
"RTN","SAMICAS3",248,0)
 ;
"RTN","SAMICAS3",249,0)
 ;
"RTN","SAMICAS3",250,0)
PRIORCMP(sid) ; dates of all scans before last comparison scan
"RTN","SAMICAS3",251,0)
 ;
"RTN","SAMICAS3",252,0)
 n retstr s retstr=""
"RTN","SAMICAS3",253,0)
 n lastcmp s lastcmp=""
"RTN","SAMICAS3",254,0)
 n fary
"RTN","SAMICAS3",255,0)
 d SORTFRMS(.fary,sid)
"RTN","SAMICAS3",256,0)
 n tdt s tdt=$P($$NOW^XLFDT,".",1) ; start with before today
"RTN","SAMICAS3",257,0)
 f  s tdt=$o(fary(tdt),-1) q:tdt=""  d  ; 
"RTN","SAMICAS3",258,0)
 . i lastcmp="" d  ; first find the last comparison scan
"RTN","SAMICAS3",259,0)
 . . n tmpkey s tmpkey=""
"RTN","SAMICAS3",260,0)
 . . f  s tmpkey=$o(fary(tdt,tmpkey)) q:tmpkey=""  q:lastcmp'=""  d  ; 
"RTN","SAMICAS3",261,0)
 . . . i tmpkey["ceform" s lastcmp=tmpkey
"RTN","SAMICAS3",262,0)
 . e  d  ;
"RTN","SAMICAS3",263,0)
 . . ; next add all previous scans to retstr
"RTN","SAMICAS3",264,0)
 . . n tmpkey2 s tmpkey2=""
"RTN","SAMICAS3",265,0)
 . . f  s tmpkey2=$o(fary(tdt,tmpkey2)) q:tmpkey2=""  d  ; 
"RTN","SAMICAS3",266,0)
 . . . i tmpkey2["ceform" d  ; convert to external date
"RTN","SAMICAS3",267,0)
 . . . . n fmdt
"RTN","SAMICAS3",268,0)
 . . . . s fmdt=$$KEY2FM^SAMICASE(tmpkey2)
"RTN","SAMICAS3",269,0)
 . . . . s retstr=$$VAPALSDT^SAMICASE(fmdt)_","_retstr
"RTN","SAMICAS3",270,0)
 i $e(retstr,$l(retstr))="," s retstr=$e(retstr,1,$l(retstr)-1)
"RTN","SAMICAS3",271,0)
 ;
"RTN","SAMICAS3",272,0)
 q retstr ; end of $$PRIORCMP
"RTN","SAMICAS3",273,0)
 ;
"RTN","SAMICAS3",274,0)
 ;
"RTN","SAMICAS3",275,0)
 ;
"RTN","SAMICAS3",276,0)
SORTFRMS(ARY,sid) ; sorts all forms for patient sid by date
"RTN","SAMICAS3",277,0)
 ;
"RTN","SAMICAS3",278,0)
 ; and returns in ARY, passed by reference
"RTN","SAMICAS3",279,0)
 ; format of return is ARY(fmdate,key)=""
"RTN","SAMICAS3",280,0)
 ;
"RTN","SAMICAS3",281,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMICAS3",282,0)
 q:'$d(@root@("graph",sid))
"RTN","SAMICAS3",283,0)
 n froot s froot=$na(@root@("graph",sid))
"RTN","SAMICAS3",284,0)
 n zi s zi=""
"RTN","SAMICAS3",285,0)
 f  s zi=$o(@froot@(zi)) q:zi=""  d  ;
"RTN","SAMICAS3",286,0)
 . n ftype s ftype=$p(zi,"-",1)
"RTN","SAMICAS3",287,0)
 . n fdate s fdate=$p(zi,ftype_"-",2)
"RTN","SAMICAS3",288,0)
 . n X,Y
"RTN","SAMICAS3",289,0)
 . s X=fdate
"RTN","SAMICAS3",290,0)
 . D ^%DT
"RTN","SAMICAS3",291,0)
 . i Y=-1 d ^ZTER Q  ;
"RTN","SAMICAS3",292,0)
 . S ARY(Y,zi)=""
"RTN","SAMICAS3",293,0)
 ;
"RTN","SAMICAS3",294,0)
 q  ; end of SORTFRMS
"RTN","SAMICAS3",295,0)
 ;
"RTN","SAMICAS3",296,0)
 ;
"RTN","SAMICAS3",297,0)
 ;
"RTN","SAMICAS3",298,0)
MKCEFORM(sid,key) ; create ct evaluation form
"RTN","SAMICAS3",299,0)
 ;
"RTN","SAMICAS3",300,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMICAS3",301,0)
 ;
"RTN","SAMICAS3",302,0)
 ;ven/gpl;private;procedure;
"RTN","SAMICAS3",303,0)
 ;@called-by
"RTN","SAMICAS3",304,0)
 ; WSNFPOST^SAMICAS3
"RTN","SAMICAS3",305,0)
 ;@calls
"RTN","SAMICAS3",306,0)
 ; $$setroot^%wd
"RTN","SAMICAS3",307,0)
 ; $$SID2NUM^SAMIHOM3
"RTN","SAMICAS3",308,0)
 ;@input
"RTN","SAMICAS3",309,0)
 ; sid = study id
"RTN","SAMICAS3",310,0)
 ; key =
"RTN","SAMICAS3",311,0)
 ;@output
"RTN","SAMICAS3",312,0)
 ; @root@("graph",sid,key)
"RTN","SAMICAS3",313,0)
 ;@examples [tbd]
"RTN","SAMICAS3",314,0)
 ;@tests [tbd]
"RTN","SAMICAS3",315,0)
 ;
"RTN","SAMICAS3",316,0)
 ;@stanza 2 create ct eval form
"RTN","SAMICAS3",317,0)
 ;
"RTN","SAMICAS3",318,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMICAS3",319,0)
 new sien set sien=$$SID2NUM^SAMIHOM3(sid)
"RTN","SAMICAS3",320,0)
 quit:+sien=0
"RTN","SAMICAS3",321,0)
 new cdate set cdate=$piece(key,"ceform-",2)
"RTN","SAMICAS3",322,0)
 ; nodule copy
"RTN","SAMICAS3",323,0)
 ;n srckey s srckey=$$PREVNOD(sid)
"RTN","SAMICAS3",324,0)
 n srckey,srcdate s srcdate=$$LASTCMP(sid,.srckey)
"RTN","SAMICAS3",325,0)
 i srckey'="" d  ;
"RTN","SAMICAS3",326,0)
 . new target,source
"RTN","SAMICAS3",327,0)
 . set source=$name(@root@("graph",sid,srckey))
"RTN","SAMICAS3",328,0)
 . set target=$name(@root@("graph",sid,key))
"RTN","SAMICAS3",329,0)
 . d CTCOPY^SAMICTC1(source,target)
"RTN","SAMICAS3",330,0)
 ; end nodule copy
"RTN","SAMICAS3",331,0)
 ;new items,prevct
"RTN","SAMICAS3",332,0)
 ;do GETITEMS^SAMICASE("items",sid)
"RTN","SAMICAS3",333,0)
 ;set prevct=""
"RTN","SAMICAS3",334,0)
 ;if $data(items("type","vapals:ceform")) do  ;previous cteval exists
"RTN","SAMICAS3",335,0)
 ;. set prevct=$order(items("type","vapals:ceform",""),-1) ; latest ceform
"RTN","SAMICAS3",336,0)
 ;if prevct'="" do  ;
"RTN","SAMICAS3",337,0)
 ;. new target,source
"RTN","SAMICAS3",338,0)
 ;. set source=$name(@root@("graph",sid,prevct))
"RTN","SAMICAS3",339,0)
 ;. set target=$name(@root@("graph",sid,key))
"RTN","SAMICAS3",340,0)
 ;. do CTCOPY^SAMICTC1(source,target)
"RTN","SAMICAS3",341,0)
 merge @root@("graph",sid,key)=@root@(sien)
"RTN","SAMICAS3",342,0)
 set @root@("graph",sid,key,"samicreatedate")=cdate
"RTN","SAMICAS3",343,0)
 do SSAMISTA^SAMICASE(sid,key,"incomplete")
"RTN","SAMICAS3",344,0)
 ; set baseline CT date and last comparison scan date
"RTN","SAMICAS3",345,0)
 do  ;
"RTN","SAMICAS3",346,0)
 . n tmpdt
"RTN","SAMICAS3",347,0)
 . s tmpdt=$$BASELNDT^SAMICAS3(sid)
"RTN","SAMICAS3",348,0)
 . q:tmpdt=-1
"RTN","SAMICAS3",349,0)
 . s @root@("graph",sid,key,"sidoe")=tmpdt
"RTN","SAMICAS3",350,0)
 . s @root@("graph",sid,key,"cedcs")=$$LASTCMP^SAMICAS3(sid)
"RTN","SAMICAS3",351,0)
 . s @root@("graph",sid,key,"cedps")=$$PRIORCMP^SAMICAS3(sid)
"RTN","SAMICAS3",352,0)
 ;
"RTN","SAMICAS3",353,0)
 ;@stanza 3 termination
"RTN","SAMICAS3",354,0)
 ;
"RTN","SAMICAS3",355,0)
 quit  ; end of MKCEFORM
"RTN","SAMICAS3",356,0)
 ;
"RTN","SAMICAS3",357,0)
 ;
"RTN","SAMICAS3",358,0)
 ;
"RTN","SAMICAS3",359,0)
MKFUFORM(sid,key) ; create Follow-up form
"RTN","SAMICAS3",360,0)
 ;
"RTN","SAMICAS3",361,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMICAS3",362,0)
 ;
"RTN","SAMICAS3",363,0)
 ;ven/gpl;private;procedure;
"RTN","SAMICAS3",364,0)
 ;@called-by
"RTN","SAMICAS3",365,0)
 ; WSNFPOST^SAMICAS3
"RTN","SAMICAS3",366,0)
 ;@calls
"RTN","SAMICAS3",367,0)
 ; $$setroot^%wd
"RTN","SAMICAS3",368,0)
 ; $$SID2NUM^SAMIHOM3
"RTN","SAMICAS3",369,0)
 ;@input
"RTN","SAMICAS3",370,0)
 ; sid = study id
"RTN","SAMICAS3",371,0)
 ; key =
"RTN","SAMICAS3",372,0)
 ;@output
"RTN","SAMICAS3",373,0)
 ; @root@("graph",sid,key)
"RTN","SAMICAS3",374,0)
 ;@examples [tbd]
"RTN","SAMICAS3",375,0)
 ;@tests [tbd]
"RTN","SAMICAS3",376,0)
 ;
"RTN","SAMICAS3",377,0)
 ;@stanza 2 create Follow-up form
"RTN","SAMICAS3",378,0)
 ;
"RTN","SAMICAS3",379,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMICAS3",380,0)
 new sien set sien=$$SID2NUM^SAMIHOM3(sid)
"RTN","SAMICAS3",381,0)
 quit:+sien=0
"RTN","SAMICAS3",382,0)
 new cdate set cdate=$piece(key,"fuform-",2)
"RTN","SAMICAS3",383,0)
 merge @root@("graph",sid,key)=@root@(sien)
"RTN","SAMICAS3",384,0)
 set @root@("graph",sid,key,"samicreatedate")=cdate
"RTN","SAMICAS3",385,0)
 set @root@("graph",sid,key,"sidof")=$$KEY2DSPD^SAMICAS2(cdate)
"RTN","SAMICAS3",386,0)
 set @root@("graph",sid,key,"sidoe")=$$BASELNDT(sid)
"RTN","SAMICAS3",387,0)
 do SSAMISTA^SAMICASE(sid,key,"incomplete")
"RTN","SAMICAS3",388,0)
 ;
"RTN","SAMICAS3",389,0)
 ;@stanza 3 termination
"RTN","SAMICAS3",390,0)
 ;
"RTN","SAMICAS3",391,0)
 quit  ; end of MKFUFORM
"RTN","SAMICAS3",392,0)
 ;
"RTN","SAMICAS3",393,0)
 ;
"RTN","SAMICAS3",394,0)
 ;
"RTN","SAMICAS3",395,0)
BASELNDT(sid) ; last previous baseline ct date
"RTN","SAMICAS3",396,0)
 ;
"RTN","SAMICAS3",397,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMICAS3",398,0)
 n groot s groot=$na(@root@("graph",sid))
"RTN","SAMICAS3",399,0)
 n items s items=""
"RTN","SAMICAS3",400,0)
 d GETITEMS^SAMICASE("items",sid)
"RTN","SAMICAS3",401,0)
 q:'$d(items) ""
"RTN","SAMICAS3",402,0)
 n bdate s bdate=""
"RTN","SAMICAS3",403,0)
 n bkey s bkey=""
"RTN","SAMICAS3",404,0)
 n done s done=0
"RTN","SAMICAS3",405,0)
 f  s bkey=$o(items("type","vapals:ceform",bkey)) q:bkey=""  d  ;
"RTN","SAMICAS3",406,0)
 . ;w !,bkey," ",$g(@groot@(bkey,"cetex"))
"RTN","SAMICAS3",407,0)
 . if $g(@groot@(bkey,"cetex"))="b" d  ;
"RTN","SAMICAS3",408,0)
 . . s done=1
"RTN","SAMICAS3",409,0)
 . . s bdate=$p(bkey,"ceform-",2)
"RTN","SAMICAS3",410,0)
 s bdate=$$KEY2DSPD^SAMICAS2(bdate)
"RTN","SAMICAS3",411,0)
 ;
"RTN","SAMICAS3",412,0)
 q bdate ; end of $$BASELNDT
"RTN","SAMICAS3",413,0)
 ;
"RTN","SAMICAS3",414,0)
 ;
"RTN","SAMICAS3",415,0)
 ;
"RTN","SAMICAS3",416,0)
MKPTFORM(sid,key) ; create pet evaluation form
"RTN","SAMICAS3",417,0)
 ;
"RTN","SAMICAS3",418,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMICAS3",419,0)
 ;
"RTN","SAMICAS3",420,0)
 ;ven/gpl;private;procedure;
"RTN","SAMICAS3",421,0)
 ;@called-by
"RTN","SAMICAS3",422,0)
 ; WSNFPOST^SAMICAS3
"RTN","SAMICAS3",423,0)
 ;@calls
"RTN","SAMICAS3",424,0)
 ; $$setroot^%wd
"RTN","SAMICAS3",425,0)
 ; $$SID2NUM^SAMIHOM3
"RTN","SAMICAS3",426,0)
 ;@input
"RTN","SAMICAS3",427,0)
 ; sid = study id
"RTN","SAMICAS3",428,0)
 ; key =
"RTN","SAMICAS3",429,0)
 ;@output
"RTN","SAMICAS3",430,0)
 ; @root@("graph",sid,key)
"RTN","SAMICAS3",431,0)
 ;@examples [tbd]
"RTN","SAMICAS3",432,0)
 ;@tests [tbd]
"RTN","SAMICAS3",433,0)
 ;
"RTN","SAMICAS3",434,0)
 ;@stanza 2 create pet eval form
"RTN","SAMICAS3",435,0)
 ;
"RTN","SAMICAS3",436,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMICAS3",437,0)
 new sien set sien=$$SID2NUM^SAMIHOM3(sid)
"RTN","SAMICAS3",438,0)
 quit:+sien=0
"RTN","SAMICAS3",439,0)
 ; nodule copy
"RTN","SAMICAS3",440,0)
 ;n srckey s srckey=$$PREVNOD(sid)
"RTN","SAMICAS3",441,0)
 n srckey,srcdate s srcdate=$$LASTCMP(sid,.srckey)
"RTN","SAMICAS3",442,0)
 i srckey'="" d  ;
"RTN","SAMICAS3",443,0)
 . new target,source
"RTN","SAMICAS3",444,0)
 . set source=$name(@root@("graph",sid,srckey))
"RTN","SAMICAS3",445,0)
 . set target=$name(@root@("graph",sid,key))
"RTN","SAMICAS3",446,0)
 . d CTCOPY^SAMICTC1(source,target)
"RTN","SAMICAS3",447,0)
 ; end nodule copy
"RTN","SAMICAS3",448,0)
 new cdate set cdate=$piece(key,"ptform-",2)
"RTN","SAMICAS3",449,0)
 merge @root@("graph",sid,key)=@root@(sien)
"RTN","SAMICAS3",450,0)
 set @root@("graph",sid,key,"samicreatedate")=cdate
"RTN","SAMICAS3",451,0)
 do SSAMISTA^SAMICASE(sid,key,"incomplete")
"RTN","SAMICAS3",452,0)
 ;
"RTN","SAMICAS3",453,0)
 ;@stanza 3 termination
"RTN","SAMICAS3",454,0)
 ;
"RTN","SAMICAS3",455,0)
 quit  ; end of MKPTFORM
"RTN","SAMICAS3",456,0)
 ;
"RTN","SAMICAS3",457,0)
 ;
"RTN","SAMICAS3",458,0)
 ;
"RTN","SAMICAS3",459,0)
MKITFORM(sid,key) ; create intervention form
"RTN","SAMICAS3",460,0)
 ;
"RTN","SAMICAS3",461,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMICAS3",462,0)
 ;
"RTN","SAMICAS3",463,0)
 ;ven/gpl;private;procedure;
"RTN","SAMICAS3",464,0)
 ;@called-by
"RTN","SAMICAS3",465,0)
 ; WSNFPOST^SAMICAS3
"RTN","SAMICAS3",466,0)
 ;@calls
"RTN","SAMICAS3",467,0)
 ; $$setroot^%wd
"RTN","SAMICAS3",468,0)
 ; $$SID2NUM^SAMIHOM3
"RTN","SAMICAS3",469,0)
 ;@input
"RTN","SAMICAS3",470,0)
 ; sid = study id
"RTN","SAMICAS3",471,0)
 ; key =
"RTN","SAMICAS3",472,0)
 ;@output
"RTN","SAMICAS3",473,0)
 ; @root@("graph",sid,key)
"RTN","SAMICAS3",474,0)
 ;@examples [tbd]
"RTN","SAMICAS3",475,0)
 ;@tests [tbd]
"RTN","SAMICAS3",476,0)
 ;
"RTN","SAMICAS3",477,0)
 ;@stanza 2 create intervention form
"RTN","SAMICAS3",478,0)
 ;
"RTN","SAMICAS3",479,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMICAS3",480,0)
 new sien set sien=$$SID2NUM^SAMIHOM3(sid)
"RTN","SAMICAS3",481,0)
 quit:+sien=0
"RTN","SAMICAS3",482,0)
 new cdate set cdate=$piece(key,"itform-",2)
"RTN","SAMICAS3",483,0)
 merge @root@("graph",sid,key)=@root@(sien)
"RTN","SAMICAS3",484,0)
 set @root@("graph",sid,key,"samicreatedate")=cdate
"RTN","SAMICAS3",485,0)
 do SSAMISTA^SAMICASE(sid,key,"incomplete")
"RTN","SAMICAS3",486,0)
 ;
"RTN","SAMICAS3",487,0)
 ;@stanza 3 termination
"RTN","SAMICAS3",488,0)
 ;
"RTN","SAMICAS3",489,0)
 quit  ; end of MKITFORM
"RTN","SAMICAS3",490,0)
 ;
"RTN","SAMICAS3",491,0)
 ;
"RTN","SAMICAS3",492,0)
 ;
"RTN","SAMICAS3",493,0)
MKBXFORM(sid,key) ; create biopsy form
"RTN","SAMICAS3",494,0)
 ;
"RTN","SAMICAS3",495,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMICAS3",496,0)
 ;
"RTN","SAMICAS3",497,0)
 ;ven/gpl;private;procedure;
"RTN","SAMICAS3",498,0)
 ;@called-by
"RTN","SAMICAS3",499,0)
 ; WSNFPOST^SAMICAS3
"RTN","SAMICAS3",500,0)
 ;@calls
"RTN","SAMICAS3",501,0)
 ; $$setroot^%wd
"RTN","SAMICAS3",502,0)
 ; $$SID2NUM^SAMIHOM3
"RTN","SAMICAS3",503,0)
 ;@input
"RTN","SAMICAS3",504,0)
 ; sid = study id
"RTN","SAMICAS3",505,0)
 ; key =
"RTN","SAMICAS3",506,0)
 ;@output
"RTN","SAMICAS3",507,0)
 ; @root@("graph",sid,key)
"RTN","SAMICAS3",508,0)
 ;@examples [tbd]
"RTN","SAMICAS3",509,0)
 ;@tests [tbd]
"RTN","SAMICAS3",510,0)
 ;
"RTN","SAMICAS3",511,0)
 ;@stanza 2 create background form
"RTN","SAMICAS3",512,0)
 ;
"RTN","SAMICAS3",513,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMICAS3",514,0)
 new sien set sien=$$SID2NUM^SAMIHOM3(sid)
"RTN","SAMICAS3",515,0)
 quit:+sien=0
"RTN","SAMICAS3",516,0)
 new cdate set cdate=$piece(key,"bxform-",2)
"RTN","SAMICAS3",517,0)
 ; nodule copy
"RTN","SAMICAS3",518,0)
 ;n srckey s srckey=$$PREVNOD(sid)
"RTN","SAMICAS3",519,0)
 n srckey,srcdate s srcdate=$$LASTCMP(sid,.srckey)
"RTN","SAMICAS3",520,0)
 i srckey'="" d  ;
"RTN","SAMICAS3",521,0)
 . new target,source
"RTN","SAMICAS3",522,0)
 . set source=$name(@root@("graph",sid,srckey))
"RTN","SAMICAS3",523,0)
 . set target=$name(@root@("graph",sid,key))
"RTN","SAMICAS3",524,0)
 . d CTCOPY^SAMICTC1(source,target)
"RTN","SAMICAS3",525,0)
 ; end nodule copy
"RTN","SAMICAS3",526,0)
 merge @root@("graph",sid,key)=@root@(sien)
"RTN","SAMICAS3",527,0)
 set @root@("graph",sid,key,"samicreatedate")=cdate
"RTN","SAMICAS3",528,0)
 do SSAMISTA^SAMICASE(sid,key,"incomplete")
"RTN","SAMICAS3",529,0)
 ;
"RTN","SAMICAS3",530,0)
 ;@stanza 3 termination
"RTN","SAMICAS3",531,0)
 ;
"RTN","SAMICAS3",532,0)
 quit  ; end of MKBXFORM
"RTN","SAMICAS3",533,0)
 ;
"RTN","SAMICAS3",534,0)
 ;
"RTN","SAMICAS3",535,0)
 ;
"RTN","SAMICAS3",536,0)
CASETBL(ary) ; generates case review table
"RTN","SAMICAS3",537,0)
 ;
"RTN","SAMICAS3",538,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMICAS3",539,0)
 ;
"RTN","SAMICAS3",540,0)
 ;ven/gpl;private;procedure;
"RTN","SAMICAS3",541,0)
 ;@called by : none
"RTN","SAMICAS3",542,0)
 ;@calls
"RTN","SAMICAS3",543,0)
 ;@input
"RTN","SAMICAS3",544,0)
 ; ary = name of array (passed by name, will be cleared)
"RTN","SAMICAS3",545,0)
 ;@output
"RTN","SAMICAS3",546,0)
 ; @ary
"RTN","SAMICAS3",547,0)
 ;@tests
"RTN","SAMICAS3",548,0)
 ; SAMIUTS2
"RTN","SAMICAS3",549,0)
 ;
"RTN","SAMICAS3",550,0)
 ;@stanza 2 build table
"RTN","SAMICAS3",551,0)
 ;
"RTN","SAMICAS3",552,0)
 kill @ary
"RTN","SAMICAS3",553,0)
 ;
"RTN","SAMICAS3",554,0)
 set @ary@("siform","form")="siform"
"RTN","SAMICAS3",555,0)
 set @ary@("siform","js")="subPr"
"RTN","SAMICAS3",556,0)
 set @ary@("siform","name")="Intake"
"RTN","SAMICAS3",557,0)
 set @ary@("siform","image")="preview.gif"
"RTN","SAMICAS3",558,0)
 ;
"RTN","SAMICAS3",559,0)
 set @ary@("nuform","form")="nuform"
"RTN","SAMICAS3",560,0)
 set @ary@("nuform","js")="subFr"
"RTN","SAMICAS3",561,0)
 set @ary@("nuform","name")="New Form"
"RTN","SAMICAS3",562,0)
 set @ary@("nuform","image")="nform.gif"
"RTN","SAMICAS3",563,0)
 ;
"RTN","SAMICAS3",564,0)
 set @ary@("sched","form")="sched"
"RTN","SAMICAS3",565,0)
 set @ary@("sched","js")="subSc"
"RTN","SAMICAS3",566,0)
 set @ary@("sched","name")="Schedule"
"RTN","SAMICAS3",567,0)
 set @ary@("sched","image")="schedule.gif"
"RTN","SAMICAS3",568,0)
 ;
"RTN","SAMICAS3",569,0)
 set @ary@("sbform","form")="sbform"
"RTN","SAMICAS3",570,0)
 set @ary@("sbform","js")="subPr"
"RTN","SAMICAS3",571,0)
 set @ary@("sbform","name")="Background"
"RTN","SAMICAS3",572,0)
 set @ary@("sbform","image")="preview.gif"
"RTN","SAMICAS3",573,0)
 ;
"RTN","SAMICAS3",574,0)
 set @ary@("ceform","form")="ceform"
"RTN","SAMICAS3",575,0)
 set @ary@("ceform","js")="subPr"
"RTN","SAMICAS3",576,0)
 set @ary@("ceform","name")="CT Evaluation"
"RTN","SAMICAS3",577,0)
 set @ary@("ceform","image")="preview.gif"
"RTN","SAMICAS3",578,0)
 ;
"RTN","SAMICAS3",579,0)
 set @ary@("report","form")="report"
"RTN","SAMICAS3",580,0)
 set @ary@("report","js")="subRp"
"RTN","SAMICAS3",581,0)
 set @ary@("report","name")="Report"
"RTN","SAMICAS3",582,0)
 set @ary@("report","image")="report.gif"
"RTN","SAMICAS3",583,0)
 ;
"RTN","SAMICAS3",584,0)
 set @ary@("ptform","form")="ptform"
"RTN","SAMICAS3",585,0)
 set @ary@("ptform","js")="subPr"
"RTN","SAMICAS3",586,0)
 set @ary@("ptform","name")="PET Evaluation"
"RTN","SAMICAS3",587,0)
 set @ary@("ptform","image")="preview.gif"
"RTN","SAMICAS3",588,0)
 ;
"RTN","SAMICAS3",589,0)
 set @ary@("bxform","form")="bxform"
"RTN","SAMICAS3",590,0)
 set @ary@("bxform","js")="subPr"
"RTN","SAMICAS3",591,0)
 set @ary@("bxform","name")="Biopsy"
"RTN","SAMICAS3",592,0)
 set @ary@("bxform","image")="preview.gif"
"RTN","SAMICAS3",593,0)
 ;
"RTN","SAMICAS3",594,0)
 set @ary@("rbform","form")="rbform"
"RTN","SAMICAS3",595,0)
 set @ary@("rbform","js")="subPr"
"RTN","SAMICAS3",596,0)
 set @ary@("rbform","name")="Intervention"
"RTN","SAMICAS3",597,0)
 set @ary@("rbform","image")="preview.gif"
"RTN","SAMICAS3",598,0)
 ;
"RTN","SAMICAS3",599,0)
 set @ary@("ceform","form")="ceform"
"RTN","SAMICAS3",600,0)
 set @ary@("ceform","js")="subPr"
"RTN","SAMICAS3",601,0)
 set @ary@("ceform","name")="CT Evaluation"
"RTN","SAMICAS3",602,0)
 set @ary@("ceform","image")="preview.gif"
"RTN","SAMICAS3",603,0)
 ;
"RTN","SAMICAS3",604,0)
 ;@stanza 3 termination
"RTN","SAMICAS3",605,0)
 ;
"RTN","SAMICAS3",606,0)
 quit  ; end of CASETBL
"RTN","SAMICAS3",607,0)
 ;
"RTN","SAMICAS3",608,0)
 ;
"RTN","SAMICAS3",609,0)
 ;
"RTN","SAMICAS3",610,0)
EOR ; end of routine SAMICAS3
"RTN","SAMICUL")
0^5^B129347
"RTN","SAMICUL",1,0)
SAMICUL ;ven/gpl - ielcap: case review page log ;2021-03-17T15:09Z
"RTN","SAMICUL",2,0)
 ;;18.0;SAMI;**9**;;Build 5
"RTN","SAMICUL",3,0)
 ;;1.18.0.9-i9
"RTN","SAMICUL",4,0)
 ;
"RTN","SAMICUL",5,0)
 ; SAMICASE contains subroutines for producing the ELCAP Case
"RTN","SAMICUL",6,0)
 ; Review Page.
"RTN","SAMICUL",7,0)
 ; SAMICUL contains the development log for the SAMICA* routines.
"RTN","SAMICUL",8,0)
 ; It contains no executable code.
"RTN","SAMICUL",9,0)
 ;
"RTN","SAMICUL",10,0)
 quit  ; no entry from top
"RTN","SAMICUL",11,0)
 ;
"RTN","SAMICUL",12,0)
 ;
"RTN","SAMICUL",13,0)
 ;
"RTN","SAMICUL",14,0)
 ;@section 0 primary development
"RTN","SAMICUL",15,0)
 ;
"RTN","SAMICUL",16,0)
 ;
"RTN","SAMICUL",17,0)
 ;
"RTN","SAMICUL",18,0)
 ;@routine-credits
"RTN","SAMICUL",19,0)
 ;@primary-dev George P. Lilly (gpl)
"RTN","SAMICUL",20,0)
 ; gpl@vistaexpertise.net
"RTN","SAMICUL",21,0)
 ;@primary-dev-org Vista Expertise Network (ven)
"RTN","SAMICUL",22,0)
 ; http://vistaexpertise.net
"RTN","SAMICUL",23,0)
 ;@copyright 2017/2021, gpl, all rights reserved
"RTN","SAMICUL",24,0)
 ;@license see routine SAMIUL
"RTN","SAMICUL",25,0)
 ;
"RTN","SAMICUL",26,0)
 ;@last-updated 2021-03-17T15:09Z
"RTN","SAMICUL",27,0)
 ;@application Screening Applications Management (SAM)
"RTN","SAMICUL",28,0)
 ;@module Screening Applications Management - IELCAP (SAMI)
"RTN","SAMICUL",29,0)
 ;@suite-of-files SAMI Forms (311.101-311.199)
"RTN","SAMICUL",30,0)
 ;@version 1.18.0.9-i9
"RTN","SAMICUL",31,0)
 ;@release-date 2020-01
"RTN","SAMICUL",32,0)
 ;@patch-list **9**
"RTN","SAMICUL",33,0)
 ;
"RTN","SAMICUL",34,0)
 ;@additional-dev Frederick D. S. Marshall (toad)
"RTN","SAMICUL",35,0)
 ; toad@vistaexpertise.net
"RTN","SAMICUL",36,0)
 ;@additional-dev Linda M. R. Yaw (lmry)
"RTN","SAMICUL",37,0)
 ; linda.yaw@vistaexpertise.net
"RTN","SAMICUL",38,0)
 ;@additional-dev Larry G. Carlson (lgc)
"RTN","SAMICUL",39,0)
 ; larry.g.carlson@gmail.com
"RTN","SAMICUL",40,0)
 ;@additional-dev Domenick DiNatale (ddn)
"RTN","SAMICUL",41,0)
 ; domenic@intellitechinnovations.com
"RTN","SAMICUL",42,0)
 ;
"RTN","SAMICUL",43,0)
 ;@module-credits
"RTN","SAMICUL",44,0)
 ;@project VA Partnership to Increase Access to Lung Screening
"RTN","SAMICUL",45,0)
 ; (VA-PALS)
"RTN","SAMICUL",46,0)
 ; http://va-pals.org/
"RTN","SAMICUL",47,0)
 ;@funding 2017/2021, Bristol-Myers Squibb Foundation (bmsf)
"RTN","SAMICUL",48,0)
 ; https://www.bms.com/about-us/responsibility/bristol-myers-squibb-foundation.html
"RTN","SAMICUL",49,0)
 ;@partner-org Veterans Affairs Office of Rural health
"RTN","SAMICUL",50,0)
 ; https://www.ruralhealth.va.gov/
"RTN","SAMICUL",51,0)
 ;@partner-org International Early Lung Cancer Action Program (I-ELCAP)
"RTN","SAMICUL",52,0)
 ; http://ielcap.com/
"RTN","SAMICUL",53,0)
 ;@partner-org Paraxial Technologies (par)
"RTN","SAMICUL",54,0)
 ; http://paraxialtech.com/
"RTN","SAMICUL",55,0)
 ;@partner-org Open Source Electronic Health Record Alliance (OSEHRA)
"RTN","SAMICUL",56,0)
 ; https://www.osehra.org/groups/va-pals-open-source-project-group
"RTN","SAMICUL",57,0)
 ;
"RTN","SAMICUL",58,0)
 ;@module-log repo github.com:VA-PALS-ELCAP/SAMI-VAPALS-ELCAP.git
"RTN","SAMICUL",59,0)
 ;
"RTN","SAMICUL",60,0)
 ; 2018-01-14 ven/gpl 1.18.0-t04 SAMICASE: split from routine SAMIFRM,
"RTN","SAMICUL",61,0)
 ; include wsCASE, GETTMPL, GETITEMS, casetbl.
"RTN","SAMICUL",62,0)
 ;
"RTN","SAMICUL",63,0)
 ; 2018-02-05/08 ven/toad 1.18.0-t04
"RTN","SAMICUL",64,0)
 ;  SAMICASE: update style, license, & attribution, spell out language
"RTN","SAMICUL",65,0)
 ; elements, add white space & do-dot quits, r/replaceAll^%wfhfrom w/
"RTN","SAMICUL",66,0)
 ; replaceAll^%wf, r/$$getTemplate^%wfhform w/$$getTemplate^%wf.
"RTN","SAMICUL",67,0)
 ;
"RTN","SAMICUL",68,0)
 ; 2018-02-14 ven/toad 1.18.0-t04
"RTN","SAMICUL",69,0)
 ; SAMICASE: r/replaceAll^%wf w/findReplaceAll^%wf, r/ln w/line, add
"RTN","SAMICUL",70,0)
 ; @calls & @called-by tags, break up some long lines.
"RTN","SAMICUL",71,0)
 ;
"RTN","SAMICUL",72,0)
 ; 2018-02-27 ven/gpl 1.18.0-t04
"RTN","SAMICUL",73,0)
 ;  SAMICASE: new subroutines $$KEY2DSPD, $$GETDTKEY; in wsCASE get
"RTN","SAMICUL",74,0)
 ; 1st & last names from graph, fix paths, key forms in graph w/date.
"RTN","SAMICUL",75,0)
 ;
"RTN","SAMICUL",76,0)
 ; 2018-03-01 ven/toad 1.18.0-t04
"RTN","SAMICUL",77,0)
 ;  SAMICASE: refactor & reorganize new code, add header comments, r/
"RTN","SAMICUL",78,0)
 ; findReplaceAll^%wf w/findReplace^%ts.
"RTN","SAMICUL",79,0)
 ;
"RTN","SAMICUL",80,0)
 ; 2018-03-06 ven/gpl 1.18.0-t04
"RTN","SAMICUL",81,0)
 ;  SAMICASE: add New Form button, list rest of forms for patient, add
"RTN","SAMICUL",82,0)
 ; web services wsNuForm & wsNuFormPost & method MKCEFORM, extend
"RTN","SAMICUL",83,0)
 ; GETITEMS to get rest of forms.
"RTN","SAMICUL",84,0)
 ;
"RTN","SAMICUL",85,0)
 ; 2018-03-07/08 ven/toad 1.18.0-t04
"RTN","SAMICUL",86,0)
 ;  SAMICASE: merge George changes w/ rest, add white space, spell out
"RTN","SAMICUL",87,0)
 ; M elements, add hdr comments to new subroutines, r/findReplace^%wf
"RTN","SAMICUL",88,0)
 ; & replaceAll^%wf w/findReplace^%ts.
"RTN","SAMICUL",89,0)
 ;
"RTN","SAMICUL",90,0)
 ; 2018-03-11 ven/gpl 1.18.0-t04 9bd663ee
"RTN","SAMICUL",91,0)
 ;  SAMICAS2: vapals forms working.
"RTN","SAMICUL",92,0)
 ;
"RTN","SAMICUL",93,0)
 ; 2018-03-12 ven/gpl 1.18.0-t04 8c36c6a7
"RTN","SAMICUL",94,0)
 ;  SAMICAS2: new form works now & charts on home page.
"RTN","SAMICUL",95,0)
 ;
"RTN","SAMICUL",96,0)
 ; 2018-03-14 ven/gpl 1.18.0-t04 9653650a
"RTN","SAMICUL",97,0)
 ;  SAMICAS2: revised casereview page link, fixed external url
"RTN","SAMICUL",98,0)
 ; preservation.
"RTN","SAMICUL",99,0)
 ;
"RTN","SAMICUL",100,0)
 ; 2018-03-21 ven/gpl 1.18.0-t04 48868561
"RTN","SAMICUL",101,0)
 ;  SAMICAS2: max date insertion, case review navigation changed to
"RTN","SAMICUL",102,0)
 ; post, date order for CT Eval in case review.
"RTN","SAMICUL",103,0)
 ;
"RTN","SAMICUL",104,0)
 ; 2018-03-26 ven/gpl 1.18.0-t04 5fa4ee96
"RTN","SAMICUL",105,0)
 ;  SAMICAS2: changes to support incomplete forms display &
"RTN","SAMICUL",106,0)
 ; processing.
"RTN","SAMICUL",107,0)
 ;
"RTN","SAMICUL",108,0)
 ; 2018-03-27 ven/gpl 1.18.0-t04 cace9756
"RTN","SAMICUL",109,0)
 ;  SAMICAS2: siforms are always complete.
"RTN","SAMICUL",110,0)
 ;
"RTN","SAMICUL",111,0)
 ; 2018-04-02 ven/gpl 1.18.0-t04 00da9146
"RTN","SAMICUL",112,0)
 ;  SAMICAS2: added followup form.
"RTN","SAMICUL",113,0)
 ;
"RTN","SAMICUL",114,0)
 ; 2018-04-24 ven/gpl 1.18.0-t04 22e39d87
"RTN","SAMICUL",115,0)
 ;  SAMICAS2: added pet & biopsy forms.
"RTN","SAMICUL",116,0)
 ;
"RTN","SAMICUL",117,0)
 ; 2018-05-01 ven/gpl 1.18.0-t04 f1751c43
"RTN","SAMICUL",118,0)
 ;  SAMICAS2: fix problem with new forms: followup & pet.
"RTN","SAMICUL",119,0)
 ;
"RTN","SAMICUL",120,0)
 ; 2018-05-18 ven/lgc 1.18.0-t04 9eba8f8c
"RTN","SAMICUL",121,0)
 ;  SAMICAS2: conversion to new graph and simplified forms processing.
"RTN","SAMICUL",122,0)
 ;
"RTN","SAMICUL",123,0)
 ; 2018-05-21 ven/lgc 1.18.0-t04 0d7ed2f7
"RTN","SAMICUL",124,0)
 ;  SAMICAS2: changes for new navigation html.
"RTN","SAMICUL",125,0)
 ;
"RTN","SAMICUL",126,0)
 ; 2018-06-14 ven/lgc 1.18.0-t04 d71f4fe4
"RTN","SAMICUL",127,0)
 ;  SAMICAS2: changes to make the background form optional.
"RTN","SAMICUL",128,0)
 ;
"RTN","SAMICUL",129,0)
 ; 2018-06-20 ven/lgc 1.18.0-t04 bf03b07f
"RTN","SAMICUL",130,0)
 ;  SAMICAS2: corrections for new forms processing navigation.
"RTN","SAMICUL",131,0)
 ;
"RTN","SAMICUL",132,0)
 ; 2018-07-01 ven/lgc 1.18.0-t04 2e1541dc,8b0a4329
"RTN","SAMICUL",133,0)
 ;  SAMICAS2: add intervention forms to case review page, 1st version
"RTN","SAMICUL",134,0)
 ; of ct eval report.
"RTN","SAMICUL",135,0)
 ;
"RTN","SAMICUL",136,0)
 ; 2018-07-04 ven/lgc 1.18.0-t04 b28c1658
"RTN","SAMICUL",137,0)
 ;  SAMICAS2: fix a typo.
"RTN","SAMICUL",138,0)
 ;
"RTN","SAMICUL",139,0)
 ; 2018-07-10 ven/lgc 1.18.0-t04 2e9662b4
"RTN","SAMICUL",140,0)
 ;  SAMICAS2: repair SAMIHOM3 & redact report link.
"RTN","SAMICUL",141,0)
 ;
"RTN","SAMICUL",142,0)
 ; 2018-08-19 ven/lgc 1.18.0-t04 2ce0cab4
"RTN","SAMICUL",143,0)
 ;  SAMICAS2: use ssn instead of last5 where available.
"RTN","SAMICUL",144,0)
 ;
"RTN","SAMICUL",145,0)
 ; 2018-08-20 ven/lgc 1.18.0-t04 955fd484
"RTN","SAMICUL",146,0)
 ;  SAMICAS2: fix case review page cr lf issue.
"RTN","SAMICUL",147,0)
 ;
"RTN","SAMICUL",148,0)
 ; 2018-08-22 ven/gpl 1.18.0-t04 d67a2fe5
"RTN","SAMICUL",149,0)
 ;  SAMICAS2: turn off ctreport.
"RTN","SAMICUL",150,0)
 ;
"RTN","SAMICUL",151,0)
 ; 2018-08-30 ven/lgc 1.18.0-t04 125f1c8b
"RTN","SAMICUL",152,0)
 ;  SAMICAS2: add type index to getItems to help find last previous
"RTN","SAMICUL",153,0)
 ; form of a type.
"RTN","SAMICUL",154,0)
 ;
"RTN","SAMICUL",155,0)
 ; 2018-09-04 ven/lgc 1.18.0-t04 3e6e326f
"RTN","SAMICUL",156,0)
 ;  SAMICAS2: hide report link.
"RTN","SAMICUL",157,0)
 ;
"RTN","SAMICUL",158,0)
 ; 2018-10-14 ven/lgc 1.18.0-t04 f6e1229f
"RTN","SAMICUL",159,0)
 ;  SAMICAS2: turn on copy forward for cteval new forms.
"RTN","SAMICUL",160,0)
 ;
"RTN","SAMICUL",161,0)
 ; 2018-10-26 ven/lgc 1.18.0-t04 f19bf1ae
"RTN","SAMICUL",162,0)
 ;  SAMICAS2: ability to add multiple forms on same day.
"RTN","SAMICUL",163,0)
 ;
"RTN","SAMICUL",164,0)
 ; 2018-11-07 ven/gpl 1.18.0-t04 c76b2eac
"RTN","SAMICUL",165,0)
 ;  SAMICAS2: defend against unit test patient 1.
"RTN","SAMICUL",166,0)
 ;
"RTN","SAMICUL",167,0)
 ; 2018-11-13 ven/toad 1.18.0-t04
"RTN","SAMICUL",168,0)
 ;  SAMICAS2: SAMIHOM2 > SAMIHOM3.
"RTN","SAMICUL",169,0)
 ;
"RTN","SAMICUL",170,0)
 ; 2018-11-14 ven/lgc 1.18.0-t04 6e9799ba
"RTN","SAMICUL",171,0)
 ;  SAMICUL: fix graphstore forms.
"RTN","SAMICUL",172,0)
 ;
"RTN","SAMICUL",173,0)
 ; 2018-11-28 ven/lgc 1.18.0-t04 a9539464
"RTN","SAMICUL",174,0)
 ;  SAMICAS2: work on sac compliance.
"RTN","SAMICUL",175,0)
 ;
"RTN","SAMICUL",176,0)
 ; 2018-12-11 ven/lgc 1.18.0-t04 3ceb74b5
"RTN","SAMICUL",177,0)
 ;  SAMICAS2: update for sac compliance.
"RTN","SAMICUL",178,0)
 ;
"RTN","SAMICUL",179,0)
 ; 2018-12-19/20 ven/lgc 1.18.0-t04 7a5d3400,a14554c1
"RTN","SAMICUL",180,0)
 ;  SAMICAS2: more sac compliance, r/^gpl w/^SAMIGPL.
"RTN","SAMICUL",181,0)
 ;
"RTN","SAMICUL",182,0)
 ; 2018-12-26 ven/lgc 1.18.0-t04 8dd6f34d,51eb1635
"RTN","SAMICUL",183,0)
 ;  SAMICAS2: update for sac compliance, fix accidental reversions.
"RTN","SAMICUL",184,0)
 ;
"RTN","SAMICUL",185,0)
 ; 2019-01-10 ven/lgc 1.18.0-t04 2daba010
"RTN","SAMICUL",186,0)
 ;  SAMICAS2: update for SAC compliance.
"RTN","SAMICUL",187,0)
 ;
"RTN","SAMICUL",188,0)
 ; 2019-01-22 ven/lgc 1.18.0-t04 53681219,5ddb29c5
"RTN","SAMICUL",189,0)
 ;  SAMICAS2: add license info to each SAMI routine; edit for lower
"RTN","SAMICUL",190,0)
 ; case initials.
"RTN","SAMICUL",191,0)
 ;
"RTN","SAMICUL",192,0)
 ; 2019-02-18 ven/lgc 1.18.0-t04 76874314
"RTN","SAMICUL",193,0)
 ;  SAMICAS2,SAMICAS3: update recently edited routines.
"RTN","SAMICUL",194,0)
 ;
"RTN","SAMICUL",195,0)
 ; 2019-03-13 ven/lmry 1.18.0-t04 ef66ef16
"RTN","SAMICUL",196,0)
 ;  SAMICAS2: spell out some elements missed earlier.
"RTN","SAMICUL",197,0)
 ;
"RTN","SAMICUL",198,0)
 ; 2019-03-14 ven/lmry 1.18.0-t04 038507e2
"RTN","SAMICUL",199,0)
 ;  SAMICAS3: spell out some missed M elements, fix copy/paste errors
"RTN","SAMICUL",200,0)
 ; in comments for MKFUFORM, MKBXFORM, & MKPTFORM.
"RTN","SAMICUL",201,0)
 ;
"RTN","SAMICUL",202,0)
 ; 2019-04-16 ven/lgc 1.18.0-t04 e54b76d1
"RTN","SAMICUL",203,0)
 ;  SAMICAS2: update for SAMIFORM project.
"RTN","SAMICUL",204,0)
 ;
"RTN","SAMICUL",205,0)
 ; 2019-04-23 ven/gpl 1.18.0-t04 ce322911
"RTN","SAMICUL",206,0)
 ;  SAMICAS2: add intake notes to case review page.
"RTN","SAMICUL",207,0)
 ;
"RTN","SAMICUL",208,0)
 ; 2019-06-18 ven/lgc 1.18.0-t04 91022482
"RTN","SAMICUL",209,0)
 ;  SAMICAS3: switch fr/global ^SAMIGPL to/^SAMIUL.
"RTN","SAMICUL",210,0)
 ;
"RTN","SAMICUL",211,0)
 ; 2019-07-01 ven/gpl 1.18.0-t04 cc87cc44
"RTN","SAMICUL",212,0)
 ;  SAMICAS3: prevent >1 bkgd form/patient.
"RTN","SAMICUL",213,0)
 ;
"RTN","SAMICUL",214,0)
 ; 2019-07-07 ven/gpl 1.18.0-t04 776f7451
"RTN","SAMICUL",215,0)
 ;  SAMICAS3: resolving can't create bkgd form, branch messed up.
"RTN","SAMICUL",216,0)
 ;
"RTN","SAMICUL",217,0)
 ; 2019-08-01 ven/lgc 1.18.0-t04 d710f27d
"RTN","SAMICUL",218,0)
 ;  SAMICAS2: pull displayed facility code from Vista parameter.
"RTN","SAMICUL",219,0)
 ;
"RTN","SAMICUL",220,0)
 ; 2019-09-26 ven/gpl 1.18.0-t04 92b12324 vap-420
"RTN","SAMICUL",221,0)
 ;  SAMICAS3: prefill form date & date of baseline ct on new followup
"RTN","SAMICUL",222,0)
 ; form.
"RTN","SAMICUL",223,0)
 ;
"RTN","SAMICUL",224,0)
 ; 2019-10-01 par/ddn 1.18.0-t04 4caf1a98 vap-344
"RTN","SAMICUL",225,0)
 ;  SAMICAS2: use proper capitalization of the word "veteran".
"RTN","SAMICUL",226,0)
 ;
"RTN","SAMICUL",227,0)
 ; 2020-01-11 ven/lgc 1.18.0.1-i1 5651698a
"RTN","SAMICUL",228,0)
 ;  SAMICAS2,SAMICAS3: fix duplicate form overwriting.
"RTN","SAMICUL",229,0)
 ;
"RTN","SAMICUL",230,0)
 ; 2020-01-17 ven/lgc 1.18.0.1-i1 8557207f
"RTN","SAMICUL",231,0)
 ;  SAMICAS2: followup note.
"RTN","SAMICUL",232,0)
 ;
"RTN","SAMICUL",233,0)
 ; 2020-01-25 ven/lgc 1.18.0.3-i3 6a07a860,6a947567
"RTN","SAMICUL",234,0)
 ;  SAMICAS3: nodule copy & fix to ru, fix subtle bug in nodule copy.
"RTN","SAMICUL",235,0)
 ;
"RTN","SAMICUL",236,0)
 ; 2020-04-11 ven/gpl 1.18.0.5-i5 666f5b91,2f2c29c1
"RTN","SAMICUL",237,0)
 ;  SAMICAS2: multi-tenancy.
"RTN","SAMICUL",238,0)
 ;
"RTN","SAMICUL",239,0)
 ; 2020-05-12 ven/gpl 1.18.0.5-i5 ad11e0ea
"RTN","SAMICUL",240,0)
 ;  SAMICAS2: fix SITE on case review page.
"RTN","SAMICUL",241,0)
 ;
"RTN","SAMICUL",242,0)
 ; 2020-11-12 ven/gpl 1.18.0.9-i9 cec1ccd6
"RTN","SAMICUL",243,0)
 ;  SAMICAS2,SAMICAS3: ceform date refill upgrade.
"RTN","SAMICUL",244,0)
 ;
"RTN","SAMICUL",245,0)
 ; 2020-11-13 ven/gpl 1.18.0.9-i9 dce3c568
"RTN","SAMICUL",246,0)
 ;  SAMICAS3: prefill ceform prior scans text field.
"RTN","SAMICUL",247,0)
 ;
"RTN","SAMICUL",248,0)
 ; 2021-02-18 ven/gpl 1.18.0.9-i9 af2a0b8a
"RTN","SAMICUL",249,0)
 ;  SAMICAS3: copy last previous CT nodules instead of last nodules in
"RTN","SAMICUL",250,0)
 ; any form.
"RTN","SAMICUL",251,0)
 ;
"RTN","SAMICUL",252,0)
 ; 2021-02-21 ven/gpl 1.18.0.9-i9 3fd704fb
"RTN","SAMICUL",253,0)
 ;  SAMICAS3: fix bug in prefill logic.
"RTN","SAMICUL",254,0)
 ;
"RTN","SAMICUL",255,0)
 ; 2021-03-02 ven/gpl 1.18.0.9-i9 479dc041
"RTN","SAMICUL",256,0)
 ;  SAMICAS2: return error msg if no CT Eval form exists when
"RTN","SAMICUL",257,0)
 ; generating a FU note.
"RTN","SAMICUL",258,0)
 ;
"RTN","SAMICUL",259,0)
 ; 2021-03-10 ven/toad 1.18.0.9-i9 a46a2cc1
"RTN","SAMICUL",260,0)
 ;  SAMICUL: update log, convert to new vistaver schema.
"RTN","SAMICUL",261,0)
 ;  SAMICAS2,SAMICAS3: bump date & patch list, update contents, lt
"RTN","SAMICUL",262,0)
 ; refactor.
"RTN","SAMICUL",263,0)
 ;
"RTN","SAMICUL",264,0)
 ; 2021-03-17 ven/toad 1.18.0.9-i9
"RTN","SAMICUL",265,0)
 ;  SAMICAS2: fix xindex errors: in WSCASE add missing space between
"RTN","SAMICUL",266,0)
 ; do & comment to prevent syntax error reported as block mismatch.
"RTN","SAMICUL",267,0)
 ;  SAMICAS3: remove extra spaces at ends of 3 lines.
"RTN","SAMICUL",268,0)
 ;
"RTN","SAMICUL",269,0)
 ;
"RTN","SAMICUL",270,0)
 ;
"RTN","SAMICUL",271,0)
EOR ; end of routine SAMICUL
"RTN","SAMIHOM4")
0^4^B748595747
"RTN","SAMIHOM4",1,0)
SAMIHOM4 ;ven/gpl,arc - ielcap: home page ;2021-03-17T18:32Z
"RTN","SAMIHOM4",2,0)
 ;;18.0;SAMI;**1,4,5,6,9**;;Build 5
"RTN","SAMIHOM4",3,0)
 ;;1.18.0.9-i9
"RTN","SAMIHOM4",4,0)
 ;
"RTN","SAMIHOM4",5,0)
 ; SAMIHOM4 contains web services & other subroutines for producing
"RTN","SAMIHOM4",6,0)
 ; the ELCAP Home Page.
"RTN","SAMIHOM4",7,0)
 ;
"RTN","SAMIHOM4",8,0)
 quit  ; no entry from top
"RTN","SAMIHOM4",9,0)
 ;
"RTN","SAMIHOM4",10,0)
 ;
"RTN","SAMIHOM4",11,0)
 ;
"RTN","SAMIHOM4",12,0)
 ;@section 0 primary development
"RTN","SAMIHOM4",13,0)
 ;
"RTN","SAMIHOM4",14,0)
 ;
"RTN","SAMIHOM4",15,0)
 ;
"RTN","SAMIHOM4",16,0)
 ;@license: see routine SAMIUL
"RTN","SAMIHOM4",17,0)
 ;@documentation : see SAMICUL
"RTN","SAMIHOM4",18,0)
 ;@contents
"RTN","SAMIHOM4",19,0)
 ; WSHOME: code for ws: vapals-elcap homepage
"RTN","SAMIHOM4",20,0)
 ; WSVAPALS: code for ws: vapals post
"RTN","SAMIHOM4",21,0)
 ; REG: manual registration
"RTN","SAMIHOM4",22,0)
 ; MKPTLK: creates patient-lookup record
"RTN","SAMIHOM4",23,0)
 ; UPDTFRMS: update demographics in all forms for patient
"RTN","SAMIHOM4",24,0)
 ; MERGE: merge participant records
"RTN","SAMIHOM4",25,0)
 ; ADDUNMAT: adds unmatched report web service to system
"RTN","SAMIHOM4",26,0)
 ; DELUNMAT: deletes unmatched web service
"RTN","SAMIHOM4",27,0)
 ; WSUNMAT: navigates to unmatched report
"RTN","SAMIHOM4",28,0)
 ; $$DUPSSN = true if duplicate ssn
"RTN","SAMIHOM4",29,0)
 ; $$DUPICN = true if duplicate icn
"RTN","SAMIHOM4",30,0)
 ; $$BADICN = true if ICN checkdigits are wrong
"RTN","SAMIHOM4",31,0)
 ; SAVE: save patient-lookup record after edit
"RTN","SAMIHOM4",32,0)
 ; $$REMATCH = possible match ien
"RTN","SAMIHOM4",33,0)
 ; SETINFO: set information message text
"RTN","SAMIHOM4",34,0)
 ; SETWARN: set warning message text
"RTN","SAMIHOM4",35,0)
 ; RTNERR: redisplay page w/error message
"RTN","SAMIHOM4",36,0)
 ; RTNPAGE: display page
"RTN","SAMIHOM4",37,0)
 ; REINDXPL: reindex patient lookup
"RTN","SAMIHOM4",38,0)
 ; INDXPTLK: generate index entries in patient-lookup graph
"RTN","SAMIHOM4",39,0)
 ; UNINDXPT: remove index entries from patient-lookup graph
"RTN","SAMIHOM4",40,0)
 ; $$UCASE = uppercase
"RTN","SAMIHOM4",41,0)
 ; DEVHOME: code for ws: temporary home page for development
"RTN","SAMIHOM4",42,0)
 ; GETHOME: code for ws: homepage accessed using GET
"RTN","SAMIHOM4",43,0)
 ; WSNEWCAS: code for ws: receives post from home & creates new case
"RTN","SAMIHOM4",44,0)
 ;
"RTN","SAMIHOM4",45,0)
 ;@to-do
"RTN","SAMIHOM4",46,0)
 ; Add label comments
"RTN","SAMIHOM4",47,0)
 ;
"RTN","SAMIHOM4",48,0)
 ;
"RTN","SAMIHOM4",49,0)
 ;
"RTN","SAMIHOM4",50,0)
 ;@section 1 wsi WSHOME & related subroutines
"RTN","SAMIHOM4",51,0)
 ;
"RTN","SAMIHOM4",52,0)
 ;
"RTN","SAMIHOM4",53,0)
 ;
"RTN","SAMIHOM4",54,0)
 ;@wsi-code WSHOME^SAMIHOM3, vapals-elcap homepage
"RTN","SAMIHOM4",55,0)
WSHOME ; code for web service for SAMI homepage
"RTN","SAMIHOM4",56,0)
 ;
"RTN","SAMIHOM4",57,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMIHOM4",58,0)
 ;
"RTN","SAMIHOM4",59,0)
 ;ven/gpl;web service;procedure;
"RTN","SAMIHOM4",60,0)
 ;@signature
"RTN","SAMIHOM4",61,0)
 ; do WSHOME^SAMIHOM3(SAMIRTN,SAMIFILTER)
"RTN","SAMIHOM4",62,0)
 ;@branches-from
"RTN","SAMIHOM4",63,0)
 ; WSHOME^SAMIHOM3
"RTN","SAMIHOM4",64,0)
 ;@called-by
"RTN","SAMIHOM4",65,0)
 ;@calls
"RTN","SAMIHOM4",66,0)
 ; GETHOME
"RTN","SAMIHOM4",67,0)
 ;@input
"RTN","SAMIHOM4",68,0)
 ; SAMIFILTER
"RTN","SAMIHOM4",69,0)
 ;@output
"RTN","SAMIHOM4",70,0)
 ;.SAMIRTN
"RTN","SAMIHOM4",71,0)
 ;@examples [tbd]
"RTN","SAMIHOM4",72,0)
 ;@tests [tbd]
"RTN","SAMIHOM4",73,0)
 ;
"RTN","SAMIHOM4",74,0)
 ; no parameters required
"RTN","SAMIHOM4",75,0)
 ;
"RTN","SAMIHOM4",76,0)
 ;@stanza 2 present development or temporary homepage
"RTN","SAMIHOM4",77,0)
 ;
"RTN","SAMIHOM4",78,0)
 if $get(SAMIFILTER("test"))=1 do  quit
"RTN","SAMIHOM4",79,0)
 . do DEVHOME^SAMIHOM3(.SAMIRTN,.SAMIFILTER)
"RTN","SAMIHOM4",80,0)
 . quit
"RTN","SAMIHOM4",81,0)
 ;
"RTN","SAMIHOM4",82,0)
 if $g(SAMIFILTER("samiroute"))'="" do  quit  ; workaround for "get" access to pages
"RTN","SAMIHOM4",83,0)
 . new SAMIBODY set SAMIBODY(1)=""
"RTN","SAMIHOM4",84,0)
 . do WSVAPALS^SAMIHOM3(.SAMIFILTER,.SAMIBODY,.SAMIRTN)
"RTN","SAMIHOM4",85,0)
 ;
"RTN","SAMIHOM4",86,0)
 if $get(SAMIFILTER("dfn"))'="" do  quit  ; V4W/DLW - workaround for "get" access from CPRS
"RTN","SAMIHOM4",87,0)
 . new dfn set dfn=$get(SAMIFILTER("dfn"))
"RTN","SAMIHOM4",88,0)
 . new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMIHOM4",89,0)
 . new studyid set studyid=$get(@root@(dfn,"samistudyid"))
"RTN","SAMIHOM4",90,0)
 . new SAMIBODY
"RTN","SAMIHOM4",91,0)
 . if studyid'="" do
"RTN","SAMIHOM4",92,0)
 . . set SAMIBODY(1)="samiroute=casereview&dfn="_dfn_"&studyid="_studyid
"RTN","SAMIHOM4",93,0)
 . else  do
"RTN","SAMIHOM4",94,0)
 . . set SAMIBODY(1)="samiroute=lookup&dfn="_dfn_"&studyid="_studyid
"RTN","SAMIHOM4",95,0)
 . do WSVAPALS^SAMIHOM3(.SAMIFILTER,.SAMIBODY,.SAMIRTN)
"RTN","SAMIHOM4",96,0)
 ;
"RTN","SAMIHOM4",97,0)
 do GETHOME^SAMIHOM3(.SAMIRTN,.SAMIFILTER) ; VAPALS homepage
"RTN","SAMIHOM4",98,0)
 ;
"RTN","SAMIHOM4",99,0)
 ;@stanza 3 termination
"RTN","SAMIHOM4",100,0)
 ;
"RTN","SAMIHOM4",101,0)
 quit  ; end of wsi WSHOME^SAMIHOM3
"RTN","SAMIHOM4",102,0)
 ;
"RTN","SAMIHOM4",103,0)
 ;
"RTN","SAMIHOM4",104,0)
 ;
"RTN","SAMIHOM4",105,0)
 ;@wsi-code WSVAPALS^SAMIHOM3, vapals-elcap post
"RTN","SAMIHOM4",106,0)
WSVAPALS ; code for web service for vapals post
"RTN","SAMIHOM4",107,0)
 ;
"RTN","SAMIHOM4",108,0)
 ;ven/gpl;web service;procedure;
"RTN","SAMIHOM4",109,0)
 ;@signature
"RTN","SAMIHOM4",110,0)
 ; do WSVAPALS^SAMIHOM3(SAMIARG,SAMIBODY,SAMIRESULT)
"RTN","SAMIHOM4",111,0)
 ;@branches-from
"RTN","SAMIHOM4",112,0)
 ; WSVAPALS^SAMIHOM3
"RTN","SAMIHOM4",113,0)
 ;
"RTN","SAMIHOM4",114,0)
 ; all calls come through this gateway
"RTN","SAMIHOM4",115,0)
 ;
"RTN","SAMIHOM4",116,0)
 k ^SAMIUL("vapals")
"RTN","SAMIHOM4",117,0)
 m ^SAMIUL("vapals")=SAMIARG
"RTN","SAMIHOM4",118,0)
 m ^SAMIUL("vapals","BODY")=SAMIBODY
"RTN","SAMIHOM4",119,0)
 ;
"RTN","SAMIHOM4",120,0)
 new vars,SAMIBDY
"RTN","SAMIHOM4",121,0)
 set SAMIBDY=$get(SAMIBODY(1))
"RTN","SAMIHOM4",122,0)
 do parseBody^%wf("vars",.SAMIBDY)
"RTN","SAMIHOM4",123,0)
 m vars=SAMIARG
"RTN","SAMIHOM4",124,0)
 i $g(vars("siteid"))'="" d  ;
"RTN","SAMIHOM4",125,0)
 . i $g(vars("site"))'=$g(vars("siteid")) s vars("site")=$g(vars("siteid"))
"RTN","SAMIHOM4",126,0)
 m SAMIARG=vars
"RTN","SAMIHOM4",127,0)
 m SAMIARG=SAMIBODY
"RTN","SAMIHOM4",128,0)
 ;
"RTN","SAMIHOM4",129,0)
 ; Processing for multi-tenancy
"RTN","SAMIHOM4",130,0)
 ;
"RTN","SAMIHOM4",131,0)
 if '$d(vars("siteid")) d  ;
"RTN","SAMIHOM4",132,0)
 . if $g(vars("studyid"))="" q
"RTN","SAMIHOM4",133,0)
 . n sym s sym=$e(vars("studyid"),1,3) ; first 3 chars in studyid
"RTN","SAMIHOM4",134,0)
 . i $$SITENM2^SAMISITE(sym)=-1 q
"RTN","SAMIHOM4",135,0)
 . s vars("siteid")=sym
"RTN","SAMIHOM4",136,0)
 . s vars("site")=sym
"RTN","SAMIHOM4",137,0)
 ;
"RTN","SAMIHOM4",138,0)
 if $G(vars("site"))'="" d  ;
"RTN","SAMIHOM4",139,0)
 . n siteid s siteid=vars("site")
"RTN","SAMIHOM4",140,0)
 . s SAMIARG("siteid")=siteid
"RTN","SAMIHOM4",141,0)
 . s SAMIARG("sitetitle")=$$SITENM2^SAMISITE(siteid)_" - "_siteid
"RTN","SAMIHOM4",142,0)
 k ^gpl("siteselect")
"RTN","SAMIHOM4",143,0)
 m ^gpl("siteselect")=SAMIARG
"RTN","SAMIHOM4",144,0)
 m ^gpl("siteselect","vars")=vars
"RTN","SAMIHOM4",145,0)
 if $G(SAMIARG("siteid"))="" if '$$FINDSITE^SAMISITE(.SAMIRESULT,.SAMIARG) Q 0
"RTN","SAMIHOM4",146,0)
 new SAMISITE,SAMITITL
"RTN","SAMIHOM4",147,0)
 s SAMISITE=$G(SAMIARG("siteid"))
"RTN","SAMIHOM4",148,0)
 i $G(SAMIARG("sitetitle"))="" d  ;
"RTN","SAMIHOM4",149,0)
 . s SAMIARG("sitetitle")=$$SITENM2^SAMISITE(SAMISITE)_" - "_SAMISITE
"RTN","SAMIHOM4",150,0)
 s SAMITITL=$G(SAMIARG("sitetitle"))
"RTN","SAMIHOM4",151,0)
 m vars=SAMIARG
"RTN","SAMIHOM4",152,0)
 ;
"RTN","SAMIHOM4",153,0)
 k ^SAMIUL("vapals","vars")
"RTN","SAMIHOM4",154,0)
 merge ^SAMIUL("vapals","vars")=vars
"RTN","SAMIHOM4",155,0)
 merge ^SAMIUL("vapals","vars")=SAMIBODY
"RTN","SAMIHOM4",156,0)
 ;
"RTN","SAMIHOM4",157,0)
 n route s route=$g(vars("samiroute"))
"RTN","SAMIHOM4",158,0)
 i route=""  d GETHOME^SAMIHOM3(.SAMIRESULT,.SAMIARG) ; on error go home
"RTN","SAMIHOM4",159,0)
 ;
"RTN","SAMIHOM4",160,0)
 i route="lookup" d  q 0
"RTN","SAMIHOM4",161,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",162,0)
 . d WSLOOKUP^SAMISRC2(.SAMIARG,.SAMIBODY,.SAMIRESULT)
"RTN","SAMIHOM4",163,0)
 ;
"RTN","SAMIHOM4",164,0)
 i route="login" d  q 0
"RTN","SAMIHOM4",165,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",166,0)
 . d LOGIN^SAMISITE(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",167,0)
 ;
"RTN","SAMIHOM4",168,0)
 i route="home" d  q 0
"RTN","SAMIHOM4",169,0)
 . k ^gpl("home")
"RTN","SAMIHOM4",170,0)
 . m ^gpl("home")=SAMIARG
"RTN","SAMIHOM4",171,0)
 . s SAMIARG("samiroute")=""
"RTN","SAMIHOM4",172,0)
 . d WSHOME^SAMIHOM3(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",173,0)
 ;
"RTN","SAMIHOM4",174,0)
 i route="logout" d  q 0
"RTN","SAMIHOM4",175,0)
 . ;s SAMIARG("samiroute")="home"
"RTN","SAMIHOM4",176,0)
 . ;do WSVAPALS^SAMIHOM3(.SAMIFILTER,.SAMIARG,.SAMIRESULT)
"RTN","SAMIHOM4",177,0)
 . ;Q
"RTN","SAMIHOM4",178,0)
 . s SAMIARG("sitetitle")="Unknown Site"
"RTN","SAMIHOM4",179,0)
 . s SAMIARG("siteid")=""
"RTN","SAMIHOM4",180,0)
 . s SAMIARG("errorMessage")=""
"RTN","SAMIHOM4",181,0)
 . d RTNERR^SAMIHOM4(.SAMIRESULT,"vapals:login",.SAMIARG)
"RTN","SAMIHOM4",182,0)
 ;
"RTN","SAMIHOM4",183,0)
 i route="newcase" d  q 0
"RTN","SAMIHOM4",184,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",185,0)
 . d WSNEWCAS^SAMIHOM3(.SAMIARG,.SAMIBODY,.SAMIRESULT)
"RTN","SAMIHOM4",186,0)
 ;
"RTN","SAMIHOM4",187,0)
 i route="casereview" d  q 0
"RTN","SAMIHOM4",188,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",189,0)
 . d WSCASE^SAMICASE(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",190,0)
 ;
"RTN","SAMIHOM4",191,0)
 i route="nuform" d  q 0
"RTN","SAMIHOM4",192,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",193,0)
 . d WSNUFORM^SAMICASE(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",194,0)
 ;
"RTN","SAMIHOM4",195,0)
 i route="addform" d  q 0
"RTN","SAMIHOM4",196,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",197,0)
 . d WSNFPOST^SAMICASE(.SAMIARG,.SAMIBODY,.SAMIRESULT)
"RTN","SAMIHOM4",198,0)
 ;
"RTN","SAMIHOM4",199,0)
 i route="form" d  q 0
"RTN","SAMIHOM4",200,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",201,0)
 . d wsGetForm^%wf(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",202,0)
 ;
"RTN","SAMIHOM4",203,0)
 i route="postform" d  q 0
"RTN","SAMIHOM4",204,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",205,0)
 . d wsPostForm^%wf(.SAMIARG,.SAMIBODY,.SAMIRESULT)
"RTN","SAMIHOM4",206,0)
 . i $g(SAMIARG("form"))["siform" d  ;
"RTN","SAMIHOM4",207,0)
 . . n notr s notr=0 ; note return 0 if failure, 1 or greater if success
"RTN","SAMIHOM4",208,0)
 . . ; returns the ien of the note that was created and should be sent
"RTN","SAMIHOM4",209,0)
 . . s notr=$$NOTE^SAMINOT1(.SAMIARG)
"RTN","SAMIHOM4",210,0)
 . . if +notr>0 d  ;
"RTN","SAMIHOM4",211,0)
 . . . n SAMIFILTER
"RTN","SAMIHOM4",212,0)
 . . . s SAMIFILTER("sid")=$G(SAMIARG("studyid"))
"RTN","SAMIHOM4",213,0)
 . . . s SAMIFILTER("key")=$g(SAMIARG("form")) ;
"RTN","SAMIHOM4",214,0)
 . . . n tiuien
"RTN","SAMIHOM4",215,0)
 . . . s tiuien=+notr
"RTN","SAMIHOM4",216,0)
 . . . s SAMIFILTER("notenmbr")=tiuien
"RTN","SAMIHOM4",217,0)
 . . . n sendrslt
"RTN","SAMIHOM4",218,0)
 . . . ;s sendrslt="1^MSG9239010"
"RTN","SAMIHOM4",219,0)
 . . . s sendrslt=$$EN^SAMIORU(.SAMIFILTER) ; send the note to VistA
"RTN","SAMIHOM4",220,0)
 . . . i +sendrslt>0 d  ; success
"RTN","SAMIHOM4",221,0)
 . . . . n rtnid s rtnid=$p(sendrslt,"^",2) ; return id from HL7
"RTN","SAMIHOM4",222,0)
 . . . . ; post the id to the graph here
"RTN","SAMIHOM4",223,0)
 . . . . n sid s sid=$G(SAMIARG("studyid"))
"RTN","SAMIHOM4",224,0)
 . . . . n form s form=$G(SAMIARG("form"))
"RTN","SAMIHOM4",225,0)
 . . . . n nien s nien=$$NTIEN^SAMINOT1(sid,form) ; latest note ien
"RTN","SAMIHOM4",226,0)
 . . . . n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIHOM4",227,0)
 . . . . s @root@("graph",sid,form,"notes",nien,"hl7id")=rtnid
"RTN","SAMIHOM4",228,0)
 . . . . s SAMIARG("errorMessage")="Note successfully sent to VistA ID: "_rtnid
"RTN","SAMIHOM4",229,0)
 . . . else  d  ;
"RTN","SAMIHOM4",230,0)
 . . . . n rtnmsg s rtnmsg=$p(sendrslt,"^",2)
"RTN","SAMIHOM4",231,0)
 . . . . s SAMIARG("errorMessage")=rtnmsg
"RTN","SAMIHOM4",232,0)
 . . . d WSCASE^SAMICASE(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",233,0)
 . i $g(SAMIARG("form"))["fuform" d  ;
"RTN","SAMIHOM4",234,0)
 . . n notr s notr=0 ; note return 0 if failure, 1 or greater if success
"RTN","SAMIHOM4",235,0)
 . . ; returns the ien of the note that was created and should be sent
"RTN","SAMIHOM4",236,0)
 . . s notr=$$NOTE^SAMINOT2(.SAMIARG)
"RTN","SAMIHOM4",237,0)
 . . if +notr>0 d  ;
"RTN","SAMIHOM4",238,0)
 . . . n SAMIFILTER
"RTN","SAMIHOM4",239,0)
 . . . s SAMIFILTER("sid")=$G(SAMIARG("studyid"))
"RTN","SAMIHOM4",240,0)
 . . . s SAMIFILTER("key")=$g(SAMIARG("form")) ;
"RTN","SAMIHOM4",241,0)
 . . . n tiuien
"RTN","SAMIHOM4",242,0)
 . . . s tiuien=+notr
"RTN","SAMIHOM4",243,0)
 . . . s SAMIFILTER("notenmbr")=tiuien
"RTN","SAMIHOM4",244,0)
 . . . n sendrslt
"RTN","SAMIHOM4",245,0)
 . . . ;s sendrslt="0^Missing ORM Message"
"RTN","SAMIHOM4",246,0)
 . . . s sendrslt=$$EN^SAMIORU(.SAMIFILTER) ; send the note to VistA
"RTN","SAMIHOM4",247,0)
 . . . i +sendrslt>0 d  ; success
"RTN","SAMIHOM4",248,0)
 . . . . n rtnid s rtnid=$p(sendrslt,"^",2) ; return id from HL7
"RTN","SAMIHOM4",249,0)
 . . . . ; post the id to the graph here
"RTN","SAMIHOM4",250,0)
 . . . . n sid s sid=$G(SAMIARG("studyid"))
"RTN","SAMIHOM4",251,0)
 . . . . n form s form=$G(SAMIARG("form"))
"RTN","SAMIHOM4",252,0)
 . . . . n nien s nien=$$NTIEN^SAMINOT1(sid,form) ; latest note ien
"RTN","SAMIHOM4",253,0)
 . . . . n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIHOM4",254,0)
 . . . . s @root@("graph",sid,form,"notes",nien,"hl7id")=rtnid
"RTN","SAMIHOM4",255,0)
 . . . . s SAMIARG("errorMessage")="Note successfully sent to VistA ID: "_rtnid
"RTN","SAMIHOM4",256,0)
 . . . else  d  ;
"RTN","SAMIHOM4",257,0)
 . . . . n rtnmsg s rtnmsg=$p(sendrslt,"^",2)
"RTN","SAMIHOM4",258,0)
 . . . . i $g(SAMIARG("errorMessage"))="" d  ;
"RTN","SAMIHOM4",259,0)
 . . . . . s SAMIARG("errorMessage")=rtnmsg
"RTN","SAMIHOM4",260,0)
 . . . d WSCASE^SAMICASE(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",261,0)
 . . e  d WSCASE^SAMICASE(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",262,0)
 . e  d WSCASE^SAMICASE(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",263,0)
 ;
"RTN","SAMIHOM4",264,0)
 i route="deleteform" d  q 0
"RTN","SAMIHOM4",265,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",266,0)
 . d DELFORM^SAMICASE(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",267,0)
 ;
"RTN","SAMIHOM4",268,0)
 i route="ctreport" d  q 0
"RTN","SAMIHOM4",269,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",270,0)
 . n format s format="html"
"RTN","SAMIHOM4",271,0)
 . s format="text"
"RTN","SAMIHOM4",272,0)
 . i format="text" d WSNOTE^SAMINOT3(.SAMIRESULT,.SAMIARG) q  ;
"RTN","SAMIHOM4",273,0)
 . i format="html" d WSREPORT^SAMICTR0(.SAMIRESULT,.SAMIARG) q  ;
"RTN","SAMIHOM4",274,0)
 . ;d wsReport^SAMICTRT(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",275,0)
 ;
"RTN","SAMIHOM4",276,0)
 i route="note" d  q 0
"RTN","SAMIHOM4",277,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",278,0)
 . d WSNOTE^SAMINOT1(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",279,0)
 ;
"RTN","SAMIHOM4",280,0)
 i route="report" d  q 0
"RTN","SAMIHOM4",281,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",282,0)
 . d WSREPORT^SAMIUR(.SAMIRESULT,.vars)
"RTN","SAMIHOM4",283,0)
 ;
"RTN","SAMIHOM4",284,0)
 i route="addperson" d  q 0
"RTN","SAMIHOM4",285,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",286,0)
 . n form
"RTN","SAMIHOM4",287,0)
 . s form="vapals:addperson"
"RTN","SAMIHOM4",288,0)
 . d RTNPAGE^SAMIHOM4(.SAMIRESULT,form,.SAMIARG) q  ;
"RTN","SAMIHOM4",289,0)
 ;
"RTN","SAMIHOM4",290,0)
 i route="editperson" d  q 0
"RTN","SAMIHOM4",291,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",292,0)
 . n dfn s dfn=$g(vars("dfn")) ; must have a dfn
"RTN","SAMIHOM4",293,0)
 . i dfn="" d  q  ;
"RTN","SAMIHOM4",294,0)
 . . d GETHOME^SAMIHOM3(.SAMIRESULT,.SAMIARG) ; on error go home 
"RTN","SAMIHOM4",295,0)
 . n root s root=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",296,0)
 . n sien s sien=$o(@root@("dfn",dfn,""))
"RTN","SAMIHOM4",297,0)
 . i sien="" d  q  ;
"RTN","SAMIHOM4",298,0)
 . . d GETHOME^SAMIHOM3(.SAMIRESULT,.SAMIARG) ; on error go home 
"RTN","SAMIHOM4",299,0)
 . s vars("name")=$g(@root@(sien,"saminame"))
"RTN","SAMIHOM4",300,0)
 . s tdob=$g(@root@(sien,"dob"))
"RTN","SAMIHOM4",301,0)
 . s vars("dob")=$p(tdob,"-",2)_"/"_$p(tdob,"-",3)_"/"_$p(tdob,"-",1)
"RTN","SAMIHOM4",302,0)
 . s vars("sbdob")=$g(@root@(sien,"dob"))
"RTN","SAMIHOM4",303,0)
 . s vars("gender")=$g(@root@(sien,"sex"))
"RTN","SAMIHOM4",304,0)
 . s vars("icn")=$g(@root@(sien,"icn"))
"RTN","SAMIHOM4",305,0)
 . n tssn s tssn=$g(@root@(sien,"ssn"))
"RTN","SAMIHOM4",306,0)
 . s vars("ssn")=$e(tssn,1,3)_"-"_$e(tssn,4,5)_"-"_$e(tssn,6,9)
"RTN","SAMIHOM4",307,0)
 . s vars("last5")=$g(@root@(sien,"last5"))
"RTN","SAMIHOM4",308,0)
 . s vars("dfn")=$g(@root@(sien,"dfn"))
"RTN","SAMIHOM4",309,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",310,0)
 . n form,err,zhtml
"RTN","SAMIHOM4",311,0)
 . s form="vapals:editparticipant"
"RTN","SAMIHOM4",312,0)
 . d RTNPAGE^SAMIHOM4(.SAMIRESULT,form,.SAMIARG) q  ;
"RTN","SAMIHOM4",313,0)
 ;
"RTN","SAMIHOM4",314,0)
 i route="register" d  q 0
"RTN","SAMIHOM4",315,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",316,0)
 . d REG^SAMIHOM4(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",317,0)
 ; 
"RTN","SAMIHOM4",318,0)
 i route="editsave" d  q 0
"RTN","SAMIHOM4",319,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",320,0)
 . d SAVE^SAMIHOM4(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",321,0)
 ;
"RTN","SAMIHOM4",322,0)
 i route="merge" d  q 0
"RTN","SAMIHOM4",323,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",324,0)
 . d MERGE^SAMIHOM4(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",325,0)
 ;
"RTN","SAMIHOM4",326,0)
 quit 0  ; end of wsi WSVAPALS^SAMIHOM3
"RTN","SAMIHOM4",327,0)
 ;
"RTN","SAMIHOM4",328,0)
 ;
"RTN","SAMIHOM4",329,0)
 ;
"RTN","SAMIHOM4",330,0)
REG(SAMIRTN,SAMIARG) ; manual registration
"RTN","SAMIHOM4",331,0)
 ;
"RTN","SAMIHOM4",332,0)
 n name s name=$g(SAMIARG("name"))
"RTN","SAMIHOM4",333,0)
 ;
"RTN","SAMIHOM4",334,0)
 m ^gpl("reg")=SAMIARG
"RTN","SAMIHOM4",335,0)
 n ssn s ssn=SAMIARG("ssn")
"RTN","SAMIHOM4",336,0)
 s ssn=$tr(ssn,"-")
"RTN","SAMIHOM4",337,0)
 s SAMIARG("errorMessage")=""
"RTN","SAMIHOM4",338,0)
 s SAMIARG("errorField")=""
"RTN","SAMIHOM4",339,0)
 ; test for duplicate ssn
"RTN","SAMIHOM4",340,0)
 ;
"RTN","SAMIHOM4",341,0)
 i $$DUPSSN(ssn) d  ;
"RTN","SAMIHOM4",342,0)
 . ;s SAMIARG("errorMessage")=SAMIARG("errorMessage")_" Duplicate SSN."
"RTN","SAMIHOM4",343,0)
 . s SAMIARG("errorMessage")=SAMIARG("errorMessage")_" Duplicate SSN error. A person with that SSN is already entered in the system."
"RTN","SAMIHOM4",344,0)
 . s SAMIARG("errorField")="ssn"
"RTN","SAMIHOM4",345,0)
 ;
"RTN","SAMIHOM4",346,0)
 ; test for duplicate icn
"RTN","SAMIHOM4",347,0)
 ;
"RTN","SAMIHOM4",348,0)
 ;n icn s icn=$g(SAMIARG("icn"))
"RTN","SAMIHOM4",349,0)
 ;i icn'="" i $$DUPICN(icn) d  ;
"RTN","SAMIHOM4",350,0)
 ;. s SAMIARG("errorMessage")=SAMIARG("errorMessage")_" Duplicate ICN error. A person with that ICN is already entered in the system."
"RTN","SAMIHOM4",351,0)
 ;. s SAMIARG("errorField")="icn"
"RTN","SAMIHOM4",352,0)
 ;;
"RTN","SAMIHOM4",353,0)
 ;; test for wellformed ICN
"RTN","SAMIHOM4",354,0)
 ;;
"RTN","SAMIHOM4",355,0)
 ;i icn'="" i $$BADICN(icn) d  ;
"RTN","SAMIHOM4",356,0)
 ;. s SAMIARG("errorMessage")=SAMIARG("errorMessage")_" Invalid ICN error. The check digits in the ICN do not match"
"RTN","SAMIHOM4",357,0)
 ;. s SAMIARG("errorField")="icn"
"RTN","SAMIHOM4",358,0)
 ;;
"RTN","SAMIHOM4",359,0)
 ; if there is an error, send back to edit with error message
"RTN","SAMIHOM4",360,0)
 i $g(SAMIARG("errorMessage"))'="" d  q  ;
"RTN","SAMIHOM4",361,0)
 . n form
"RTN","SAMIHOM4",362,0)
 . s form="vapals:addperson"
"RTN","SAMIHOM4",363,0)
 . d RTNERR(.SAMIRESULT,form,.SAMIARG)
"RTN","SAMIHOM4",364,0)
 ;
"RTN","SAMIHOM4",365,0)
 n root s root=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",366,0)
 n proot s proot=$$setroot^%wd("vapals-patients")
"RTN","SAMIHOM4",367,0)
 n ptlkien s ptlkien=""
"RTN","SAMIHOM4",368,0)
 n dfn s dfn=""
"RTN","SAMIHOM4",369,0)
 n sien s sien=""
"RTN","SAMIHOM4",370,0)
 i ptlkien="" s ptlkien=$o(@root@("AAAAAA"),-1)+1
"RTN","SAMIHOM4",371,0)
 n zm
"RTN","SAMIHOM4",372,0)
 k SAMIARG("MATCHLOG")
"RTN","SAMIHOM4",373,0)
 s zm=$$REMATCH(sien,.SAMIARG)
"RTN","SAMIHOM4",374,0)
 i zm>0 d  ;
"RTN","SAMIHOM4",375,0)
 . s SAMIARG("MATCHLOG")=zm
"RTN","SAMIHOM4",376,0)
 d MKPTLK(ptlkien,.SAMIARG) ; make the patient-lookup record
"RTN","SAMIHOM4",377,0)
 ;
"RTN","SAMIHOM4",378,0)
 s dfn=$o(@root@("dfn"," "),-1)+1
"RTN","SAMIHOM4",379,0)
 n pdfn
"RTN","SAMIHOM4",380,0)
 s pdfn=$o(@proot@("dfn"," "),-1)+1
"RTN","SAMIHOM4",381,0)
 i pdfn>dfn s dfn=pdfn ; need a dfn that has not been used
"RTN","SAMIHOM4",382,0)
 i dfn<9000001 s dfn=9000001
"RTN","SAMIHOM4",383,0)
 s @root@(ptlkien,"dfn")=dfn
"RTN","SAMIHOM4",384,0)
 d INDXPTLK(ptlkien)
"RTN","SAMIHOM4",385,0)
 s SAMIFILTER("samiroute")="addperson"
"RTN","SAMIHOM4",386,0)
 s SAMIFILTER("siteid")=$G(SAMIARG("siteid"))
"RTN","SAMIHOM4",387,0)
 s SAMIFILTER("sitetitle")=$G(SAMIARG("sitetitle"))
"RTN","SAMIHOM4",388,0)
 k SAMIARG ; return to a blank manual registration form
"RTN","SAMIHOM4",389,0)
 s SAMIARG("siteid")=$G(SAMIFILTER("siteid"))
"RTN","SAMIHOM4",390,0)
 s SAMIARG("sitetitle")=$G(SAMIFILTER("sitetitle"))
"RTN","SAMIHOM4",391,0)
 d SETINFO(.SAMIFILTER,name_" was successfully entered")
"RTN","SAMIHOM4",392,0)
 ;d SETWARN(.SAMIFILTER,"We might want to give you a warning")
"RTN","SAMIHOM4",393,0)
 do WSVAPALS^SAMIHOM3(.SAMIFILTER,.SAMIARG,.SAMIRESULT)
"RTN","SAMIHOM4",394,0)
 ;
"RTN","SAMIHOM4",395,0)
 quit  ; end of REG
"RTN","SAMIHOM4",396,0)
 ;
"RTN","SAMIHOM4",397,0)
 ;
"RTN","SAMIHOM4",398,0)
 ;
"RTN","SAMIHOM4",399,0)
MKPTLK(ptlkien,SAMIARG) ; creates patient-lookup record
"RTN","SAMIHOM4",400,0)
 ;
"RTN","SAMIHOM4",401,0)
 n ssn s ssn=SAMIARG("ssn")
"RTN","SAMIHOM4",402,0)
 s ssn=$tr(ssn,"-")
"RTN","SAMIHOM4",403,0)
 n name s name=$g(SAMIARG("name"))
"RTN","SAMIHOM4",404,0)
 n sinamef,sinamel
"RTN","SAMIHOM4",405,0)
 s sinamel=$p(name,","),sinamel=$$TRIM^XLFSTR(sinamel,"LR")
"RTN","SAMIHOM4",406,0)
 s sinamef=$p(name,",",2),sinamef=$$TRIM^XLFSTR(sinamef,"LR")
"RTN","SAMIHOM4",407,0)
 s name=sinamel_","_sinamef
"RTN","SAMIHOM4",408,0)
 n siteid s siteid=$g(SAMIARG("siteid"))
"RTN","SAMIHOM4",409,0)
 i siteid="" s siteid=$g(SAMIARG("site"))
"RTN","SAMIHOM4",410,0)
 ;
"RTN","SAMIHOM4",411,0)
 s @root@(ptlkien,"siteid")=siteid
"RTN","SAMIHOM4",412,0)
 s @root@(ptlkien,"saminame")=name
"RTN","SAMIHOM4",413,0)
 s @root@(ptlkien,"sinamef")=sinamef
"RTN","SAMIHOM4",414,0)
 s @root@(ptlkien,"sinamel")=sinamel
"RTN","SAMIHOM4",415,0)
 n fmdob s fmdob=$$FMDT^SAMIUR2(SAMIARG("dob"))
"RTN","SAMIHOM4",416,0)
 n ptlkdob s ptlkdob=$$FMTE^XLFDT(fmdob,7)
"RTN","SAMIHOM4",417,0)
 s ptlkdob=$TR(ptlkdob,"/","-")
"RTN","SAMIHOM4",418,0)
 s @root@(ptlkien,"dob")=ptlkdob
"RTN","SAMIHOM4",419,0)
 s @root@(ptlkien,"sbdob")=ptlkdob
"RTN","SAMIHOM4",420,0)
 n gender s gender=SAMIARG("gender")
"RTN","SAMIHOM4",421,0)
 s @root@(ptlkien,"gender")=$s(gender="M":"M^MALE",1:"F^FEMALE")
"RTN","SAMIHOM4",422,0)
 s @root@(ptlkien,"sex")=SAMIARG("gender")
"RTN","SAMIHOM4",423,0)
 s @root@(ptlkien,"icn")=SAMIARG("icn")
"RTN","SAMIHOM4",424,0)
 s @root@(ptlkien,"ssn")=ssn
"RTN","SAMIHOM4",425,0)
 n last5 s last5=$$UCASE($e(name,1))_$e(ssn,6,9)
"RTN","SAMIHOM4",426,0)
 s @root@(ptlkien,"last5")=last5
"RTN","SAMIHOM4",427,0)
 n mymatch s mymatch=$g(SAMIARG("MATCHLOG"))
"RTN","SAMIHOM4",428,0)
 i mymatch'="" s @root@(ptlkien,"MATCHLOG")=mymatch
"RTN","SAMIHOM4",429,0)
 ;
"RTN","SAMIHOM4",430,0)
 quit  ; end of MKPTLK
"RTN","SAMIHOM4",431,0)
 ;
"RTN","SAMIHOM4",432,0)
 ;
"RTN","SAMIHOM4",433,0)
 ;
"RTN","SAMIHOM4",434,0)
UPDTFRMS(dfn) ; update demographics in all forms for patient
"RTN","SAMIHOM4",435,0)
 ;
"RTN","SAMIHOM4",436,0)
 n lroot s lroot=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",437,0)
 n proot s proot=$$setroot^%wd("vapals-patients")
"RTN","SAMIHOM4",438,0)
 n lien s lien=$o(@lroot@("dfn",dfn,""))
"RTN","SAMIHOM4",439,0)
 q:lien=""
"RTN","SAMIHOM4",440,0)
 n pien s pien=$o(@proot@("dfn",dfn,""))
"RTN","SAMIHOM4",441,0)
 q:pien=""
"RTN","SAMIHOM4",442,0)
 ; this patient has forms
"RTN","SAMIHOM4",443,0)
 m @proot@(pien)=@lroot@(lien) ; refresh the demos in the patient record
"RTN","SAMIHOM4",444,0)
 n ssn s ssn=$g(@proot@(pien,"ssn"))
"RTN","SAMIHOM4",445,0)
 s @proot@(pien,"sissn")=$e(ssn,1,3)_"-"_$e(ssn,4,5)_"-"_$e(ssn,6,9)
"RTN","SAMIHOM4",446,0)
 n sid s sid=$g(@proot@("sisid")) ; studyid 
"RTN","SAMIHOM4",447,0)
 q:sid=""  ; no studyid
"RTN","SAMIHOM4",448,0)
 n zi s zi=""
"RTN","SAMIHOM4",449,0)
 f  s zi=$o(@proot@("graph",sid,zi)) q:zi=""  d  ; for each form
"RTN","SAMIHOM4",450,0)
 . m @proot@("graph",sid,zi)=@proot@(pien) ; stamp each form with new demos
"RTN","SAMIHOM4",451,0)
 ;
"RTN","SAMIHOM4",452,0)
 quit  ; end of UPDTFRMS
"RTN","SAMIHOM4",453,0)
 ;
"RTN","SAMIHOM4",454,0)
 ;
"RTN","SAMIHOM4",455,0)
 ;
"RTN","SAMIHOM4",456,0)
MERGE(SAMIRESULT,SAMIARGS) ; merge participant records
"RTN","SAMIHOM4",457,0)
 ;
"RTN","SAMIHOM4",458,0)
 ; called from pressing the merge button on the unmatched report
"RTN","SAMIHOM4",459,0)
 ;
"RTN","SAMIHOM4",460,0)
 n toien s toien=$g(SAMIARGS("toien"))
"RTN","SAMIHOM4",461,0)
 i toien="" d  q  ;
"RTN","SAMIHOM4",462,0)
 . d WSUNMAT(.SAMIRESULT,.SAMIARGS)
"RTN","SAMIHOM4",463,0)
 n lroot s lroot=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",464,0)
 n fromien s fromien=$g(@lroot@(toien,"MATCHLOG"))
"RTN","SAMIHOM4",465,0)
 i fromien="" d  q  ;
"RTN","SAMIHOM4",466,0)
 . d WSUNMAT(.SAMIRESULT,.SAMIARGS)
"RTN","SAMIHOM4",467,0)
 ;
"RTN","SAMIHOM4",468,0)
 ; test for remotedfn in from record - not valid if absent
"RTN","SAMIHOM4",469,0)
 ;
"RTN","SAMIHOM4",470,0)
 i $g(@lroot@(fromien,"remotedfn"))="" d  q  ;
"RTN","SAMIHOM4",471,0)
 . d WSUNMAT(.SAMIRESULT,.SAMIARGS)
"RTN","SAMIHOM4",472,0)
 ;
"RTN","SAMIHOM4",473,0)
 ; remove index entries for from and to records
"RTN","SAMIHOM4",474,0)
 ;
"RTN","SAMIHOM4",475,0)
 d UNINDXPT(fromien) ; delete index entries
"RTN","SAMIHOM4",476,0)
 d UNINDXPT(toien)
"RTN","SAMIHOM4",477,0)
 ;
"RTN","SAMIHOM4",478,0)
 ; create changelog entry in to record - contains from record
"RTN","SAMIHOM4",479,0)
 ;
"RTN","SAMIHOM4",480,0)
 m @lroot@(toien,"changelog",$$FMTE^XLFDT($$NOW^XLFDT,5))=@lroot@(fromien)
"RTN","SAMIHOM4",481,0)
 ;
"RTN","SAMIHOM4",482,0)
 ; change the dfn in the from record to the to record dfn for merging
"RTN","SAMIHOM4",483,0)
 ;
"RTN","SAMIHOM4",484,0)
 s @lroot@(fromien,"dfn")=@lroot@(toien,"dfn")
"RTN","SAMIHOM4",485,0)
 n dfn s dfn=@lroot@(toien,"dfn") ; for use in updating forms
"RTN","SAMIHOM4",486,0)
 ;
"RTN","SAMIHOM4",487,0)
 ; merge the from record to the to record
"RTN","SAMIHOM4",488,0)
 ;
"RTN","SAMIHOM4",489,0)
 m @lroot@(toien)=@lroot@(fromien)
"RTN","SAMIHOM4",490,0)
 ;
"RTN","SAMIHOM4",491,0)
 ; delete the from record
"RTN","SAMIHOM4",492,0)
 ;
"RTN","SAMIHOM4",493,0)
 k @lroot@(fromien)
"RTN","SAMIHOM4",494,0)
 ;
"RTN","SAMIHOM4",495,0)
 ; reindex the to record
"RTN","SAMIHOM4",496,0)
 ;
"RTN","SAMIHOM4",497,0)
 d INDXPTLK(toien)
"RTN","SAMIHOM4",498,0)
 ;
"RTN","SAMIHOM4",499,0)
 ; propagate the updated from record to every form
"RTN","SAMIHOM4",500,0)
 ;
"RTN","SAMIHOM4",501,0)
 d UPDTFRMS(dfn) ; updates the patient in the vapals-patient graph
"RTN","SAMIHOM4",502,0)
 ;
"RTN","SAMIHOM4",503,0)
 ; leave and return to the unmatched report
"RTN","SAMIHOM4",504,0)
 ;   note that the form and to records will no longer be in the report
"RTN","SAMIHOM4",505,0)
 ;
"RTN","SAMIHOM4",506,0)
 d WSUNMAT(.SAMIRESULT,.SAMIARGS)
"RTN","SAMIHOM4",507,0)
 ;
"RTN","SAMIHOM4",508,0)
 quit  ; end of MERGE
"RTN","SAMIHOM4",509,0)
 ;
"RTN","SAMIHOM4",510,0)
 ;
"RTN","SAMIHOM4",511,0)
 ;
"RTN","SAMIHOM4",512,0)
ADDUNMAT ; adds unmatched report web service to system
"RTN","SAMIHOM4",513,0)
 ;
"RTN","SAMIHOM4",514,0)
 d addService^%webutils("GET","unmatched","WSUNMAT^SAMIHOM4")
"RTN","SAMIHOM4",515,0)
 ;
"RTN","SAMIHOM4",516,0)
 quit  ; end of ADDUNMAT
"RTN","SAMIHOM4",517,0)
 ;
"RTN","SAMIHOM4",518,0)
 ;
"RTN","SAMIHOM4",519,0)
 ;
"RTN","SAMIHOM4",520,0)
DELUNMAT ; deletes unmatched web service
"RTN","SAMIHOM4",521,0)
 ;
"RTN","SAMIHOM4",522,0)
 d deleteService^%webutils("GET","unmatched")
"RTN","SAMIHOM4",523,0)
 ;
"RTN","SAMIHOM4",524,0)
 quit  ; end of DELUNMAT
"RTN","SAMIHOM4",525,0)
 ;
"RTN","SAMIHOM4",526,0)
 ;
"RTN","SAMIHOM4",527,0)
 ;
"RTN","SAMIHOM4",528,0)
WSUNMAT(SAMIRESULT,SAMIARGS) ; navigates to unmatched report
"RTN","SAMIHOM4",529,0)
 ; 
"RTN","SAMIHOM4",530,0)
 n filter,bdy
"RTN","SAMIHOM4",531,0)
 s bdy=""
"RTN","SAMIHOM4",532,0)
 ;s filter("siteid")="PHX"
"RTN","SAMIHOM4",533,0)
 s filter("samiroute")="report"
"RTN","SAMIHOM4",534,0)
 s filter("samireporttype")="unmatched"
"RTN","SAMIHOM4",535,0)
 d WSVAPALS^SAMIHOM3(.filter,.bdy,.SAMIRESULT) ; back to the unmatched report
"RTN","SAMIHOM4",536,0)
 ;
"RTN","SAMIHOM4",537,0)
 quit  ; end of WSUNMAT
"RTN","SAMIHOM4",538,0)
 ;
"RTN","SAMIHOM4",539,0)
 ;
"RTN","SAMIHOM4",540,0)
 ;
"RTN","SAMIHOM4",541,0)
DUPSSN(ssn) ; extrinsic returns true if duplicate ssn
"RTN","SAMIHOM4",542,0)
 ;
"RTN","SAMIHOM4",543,0)
 n proot s proot=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",544,0)
 i $d(@proot@("ssn",ssn)) q 1
"RTN","SAMIHOM4",545,0)
 ;
"RTN","SAMIHOM4",546,0)
 quit 0 ; end of $$DUPSSN
"RTN","SAMIHOM4",547,0)
 ;
"RTN","SAMIHOM4",548,0)
 ;
"RTN","SAMIHOM4",549,0)
 ;
"RTN","SAMIHOM4",550,0)
DUPICN(icn) ; extrinsic returns true if duplicate icn
"RTN","SAMIHOM4",551,0)
 ;
"RTN","SAMIHOM4",552,0)
 n proot s proot=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",553,0)
 n tmpicn s tmpicn=$p(icn,"V",1)
"RTN","SAMIHOM4",554,0)
 i $d(@proot@("icn",icn)) q 1
"RTN","SAMIHOM4",555,0)
 i $d(@proot@("icn",tmpicn)) q 1
"RTN","SAMIHOM4",556,0)
 ;
"RTN","SAMIHOM4",557,0)
 quit 0 ; end of $$DUPICN
"RTN","SAMIHOM4",558,0)
 ;
"RTN","SAMIHOM4",559,0)
 ;
"RTN","SAMIHOM4",560,0)
 ;
"RTN","SAMIHOM4",561,0)
BADICN(icn) ; extrinsic returns true if ICN checkdigits are wrong
"RTN","SAMIHOM4",562,0)
 ;
"RTN","SAMIHOM4",563,0)
 n zchk s zchk=$p(icn,"V",2)
"RTN","SAMIHOM4",564,0)
 n zicn s zicn=$p(icn,"V",1)
"RTN","SAMIHOM4",565,0)
 q:zchk="" 1
"RTN","SAMIHOM4",566,0)
 i zchk'=$$CHECKDG^MPIFSPC(zicn) q 1
"RTN","SAMIHOM4",567,0)
 ;
"RTN","SAMIHOM4",568,0)
 quit 0
"RTN","SAMIHOM4",569,0)
 ;
"RTN","SAMIHOM4",570,0)
 ;
"RTN","SAMIHOM4",571,0)
 ;
"RTN","SAMIHOM4",572,0)
SAVE(SAMIRESULT,SAMIARG) ; save patient-lookup record after edit
"RTN","SAMIHOM4",573,0)
 ;
"RTN","SAMIHOM4",574,0)
 n dfn s dfn=$g(vars("dfn")) ; must have a dfn
"RTN","SAMIHOM4",575,0)
 i dfn="" d  q  ;
"RTN","SAMIHOM4",576,0)
 . d GETHOME^SAMIHOM3(.SAMIRESULT,.SAMIARG) ; on error go home 
"RTN","SAMIHOM4",577,0)
 n root s root=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",578,0)
 n sien s sien=$o(@root@("dfn",dfn,""))
"RTN","SAMIHOM4",579,0)
 i sien="" d  q  ;
"RTN","SAMIHOM4",580,0)
 . d GETHOME^SAMIHOM3(.SAMIRESULT,.SAMIARG) ; on error go home 
"RTN","SAMIHOM4",581,0)
 d UNINDXPT(sien) ; remove old index entries
"RTN","SAMIHOM4",582,0)
 n zm
"RTN","SAMIHOM4",583,0)
 k SAMIARG("MATCHLOG")
"RTN","SAMIHOM4",584,0)
 s zm=$$REMATCH(sien,.SAMIARG)
"RTN","SAMIHOM4",585,0)
 i zm>0 d  ;
"RTN","SAMIHOM4",586,0)
 . s SAMIARG("MATCHLOG")=zm
"RTN","SAMIHOM4",587,0)
 d MKPTLK(sien,.SAMIARG) ; add the updated fields
"RTN","SAMIHOM4",588,0)
 d INDXPTLK(sien) ; create new index entries
"RTN","SAMIHOM4",589,0)
 d UPDTFRMS(dfn) ; update demographic info in all forms
"RTN","SAMIHOM4",590,0)
 n filter,bdy
"RTN","SAMIHOM4",591,0)
 s bdy=""
"RTN","SAMIHOM4",592,0)
 m filter=SAMIARG
"RTN","SAMIHOM4",593,0)
 s filter("samiroute")="report"
"RTN","SAMIHOM4",594,0)
 s filter("samireporttype")="unmatched"
"RTN","SAMIHOM4",595,0)
 d WSVAPALS^SAMIHOM3(.filter,.bdy,.SAMIRESULT) ; back to the unmatched report
"RTN","SAMIHOM4",596,0)
 ;
"RTN","SAMIHOM4",597,0)
 quit  ; end of SAVE
"RTN","SAMIHOM4",598,0)
 ;
"RTN","SAMIHOM4",599,0)
 ;
"RTN","SAMIHOM4",600,0)
 ;
"RTN","SAMIHOM4",601,0)
REMATCH(sien,SAMIARG) ; extrinsic returns possible match ien
"RTN","SAMIHOM4",602,0)
 ;
"RTN","SAMIHOM4",603,0)
 ; else zero
"RTN","SAMIHOM4",604,0)
 ;
"RTN","SAMIHOM4",605,0)
 n lroot s lroot=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",606,0)
 n ssn,name,icn,x,y
"RTN","SAMIHOM4",607,0)
 s ssn=$g(SAMIARG("ssn"))
"RTN","SAMIHOM4",608,0)
 i ssn["-" s ssn=$tr(ssn,"-")
"RTN","SAMIHOM4",609,0)
 s name=$g(SAMIARG("saminame"))
"RTN","SAMIHOM4",610,0)
 i name="" s name=$g(SAMIARG("name"))
"RTN","SAMIHOM4",611,0)
 s icn=$g(SAMIARG("icn"))
"RTN","SAMIHOM4",612,0)
 s x=0
"RTN","SAMIHOM4",613,0)
 i ssn'="" s x=$o(@lroot@("ssn",ssn,""))
"RTN","SAMIHOM4",614,0)
 i x=sien s x=$o(@lroot@("ssn",ssn,x))
"RTN","SAMIHOM4",615,0)
 i +x'=0 d  ;
"RTN","SAMIHOM4",616,0)
 . s y=$g(@lroot@(x,"dfn"))
"RTN","SAMIHOM4",617,0)
 . i y>9000000 s x=0
"RTN","SAMIHOM4",618,0)
 i x>0 q x
"RTN","SAMIHOM4",619,0)
 i name'="" s x=$o(@lroot@("name",name,""))
"RTN","SAMIHOM4",620,0)
 i x=sien s x=$o(@lroot@("name",name,x))
"RTN","SAMIHOM4",621,0)
 i +x'=0 d  ;
"RTN","SAMIHOM4",622,0)
 . s y=$g(@lroot@(x,"dfn"))
"RTN","SAMIHOM4",623,0)
 . i y>9000000 s x=0
"RTN","SAMIHOM4",624,0)
 i x>0 q x
"RTN","SAMIHOM4",625,0)
 ;i icn'="" s x=$o(@lroot@("icn",icn,""))
"RTN","SAMIHOM4",626,0)
 ;i x=sien s x=$o(@lroot@("icn",icn,x))
"RTN","SAMIHOM4",627,0)
 ;i +x'=0 d  ;
"RTN","SAMIHOM4",628,0)
 ;. s y=$g(@lroot@(x,"dfn"))
"RTN","SAMIHOM4",629,0)
 ;. i y>9000000 s x=0
"RTN","SAMIHOM4",630,0)
 ;i x>0 q x
"RTN","SAMIHOM4",631,0)
 ;
"RTN","SAMIHOM4",632,0)
 quit 0 ; end of $$REMATCH
"RTN","SAMIHOM4",633,0)
 ;
"RTN","SAMIHOM4",634,0)
 ;
"RTN","SAMIHOM4",635,0)
 ;
"RTN","SAMIHOM4",636,0)
SETINFO(vars,msg) ; set information message text
"RTN","SAMIHOM4",637,0)
 ;
"RTN","SAMIHOM4",638,0)
 ; vars are the screen variables passed by reference
"RTN","SAMIHOM4",639,0)
 ;
"RTN","SAMIHOM4",640,0)
 s vars("infoMessage")=msg
"RTN","SAMIHOM4",641,0)
 ;
"RTN","SAMIHOM4",642,0)
 quit  ; end of SETINFO
"RTN","SAMIHOM4",643,0)
 ;
"RTN","SAMIHOM4",644,0)
 ;
"RTN","SAMIHOM4",645,0)
 ;
"RTN","SAMIHOM4",646,0)
SETWARN(vars,msg) ; set warning message text
"RTN","SAMIHOM4",647,0)
 ;
"RTN","SAMIHOM4",648,0)
 ; vars are the screen variables passed by reference
"RTN","SAMIHOM4",649,0)
 ;
"RTN","SAMIHOM4",650,0)
 s vars("warnMessage")=msg
"RTN","SAMIHOM4",651,0)
 ;
"RTN","SAMIHOM4",652,0)
 quit  ; end of SETWARN
"RTN","SAMIHOM4",653,0)
 ;
"RTN","SAMIHOM4",654,0)
 ;
"RTN","SAMIHOM4",655,0)
 ; 
"RTN","SAMIHOM4",656,0)
RTNERR(rtn,form,vals,msg,fld) ; redisplay page w/error message
"RTN","SAMIHOM4",657,0)
 ;
"RTN","SAMIHOM4",658,0)
 ; rtn is the return array
"RTN","SAMIHOM4",659,0)
 ; form is the form the page requires
"RTN","SAMIHOM4",660,0)
 ; vals are the values for the page. passed by reference
"RTN","SAMIHOM4",661,0)
 ; msg is the error message to be displayed
"RTN","SAMIHOM4",662,0)
 ; fld is the name of the field where the cursor should be put
"RTN","SAMIHOM4",663,0)
 ;
"RTN","SAMIHOM4",664,0)
 n zhtml ; work area for the tempate
"RTN","SAMIHOM4",665,0)
 d SAMIHTM^%wf(.zhtml,form,.err)
"RTN","SAMIHOM4",666,0)
 d MERGEHTM^%wf(.zhtml,.vals,.err)
"RTN","SAMIHOM4",667,0)
 m rtn=zhtml
"RTN","SAMIHOM4",668,0)
 set HTTPRSP("mime")="text/html" ; set mime type
"RTN","SAMIHOM4",669,0)
 ;
"RTN","SAMIHOM4",670,0)
 quit  ; end of RTNERR
"RTN","SAMIHOM4",671,0)
 ;
"RTN","SAMIHOM4",672,0)
 ;
"RTN","SAMIHOM4",673,0)
 ;
"RTN","SAMIHOM4",674,0)
RTNPAGE(rtn,form,vals) ; display page
"RTN","SAMIHOM4",675,0)
 ;
"RTN","SAMIHOM4",676,0)
 ; rtn is the return array
"RTN","SAMIHOM4",677,0)
 ; form is the form the page requires
"RTN","SAMIHOM4",678,0)
 ; vals are the values for the page. passed by reference
"RTN","SAMIHOM4",679,0)
 ;
"RTN","SAMIHOM4",680,0)
 n err
"RTN","SAMIHOM4",681,0)
 n zhtml ; work area for the tempate
"RTN","SAMIHOM4",682,0)
 d SAMIHTM^%wf(.zhtml,form,.err)
"RTN","SAMIHOM4",683,0)
 d MERGEHTM^%wf(.zhtml,.vals,.err)
"RTN","SAMIHOM4",684,0)
 m SAMIRESULT=zhtml
"RTN","SAMIHOM4",685,0)
 set HTTPRSP("mime")="text/html" ; set mime type
"RTN","SAMIHOM4",686,0)
 ;
"RTN","SAMIHOM4",687,0)
 quit  ; end of RTNPAGE
"RTN","SAMIHOM4",688,0)
 ;
"RTN","SAMIHOM4",689,0)
 ;
"RTN","SAMIHOM4",690,0)
 ;
"RTN","SAMIHOM4",691,0)
REINDXPL ; reindex patient lookup
"RTN","SAMIHOM4",692,0)
 ;
"RTN","SAMIHOM4",693,0)
 n root s root=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",694,0)
 n zi s zi=0
"RTN","SAMIHOM4",695,0)
 k @root@("ssn")
"RTN","SAMIHOM4",696,0)
 k @root@("name")
"RTN","SAMIHOM4",697,0)
 k @root@("last5")
"RTN","SAMIHOM4",698,0)
 k @root@("sinamef")
"RTN","SAMIHOM4",699,0)
 k @root@("sinamel")
"RTN","SAMIHOM4",700,0)
 k @root@("icn")
"RTN","SAMIHOM4",701,0)
 f  s zi=$o(@root@(zi)) q:+zi=0  d  ;
"RTN","SAMIHOM4",702,0)
 . d INDXPTLK(zi)
"RTN","SAMIHOM4",703,0)
 ;
"RTN","SAMIHOM4",704,0)
 quit  ; end of REINDXPL
"RTN","SAMIHOM4",705,0)
 ;
"RTN","SAMIHOM4",706,0)
 ;
"RTN","SAMIHOM4",707,0)
 ;
"RTN","SAMIHOM4",708,0)
INDXPTLK(ien) ; generate index entries in patient-lookup graph
"RTN","SAMIHOM4",709,0)
 ;
"RTN","SAMIHOM4",710,0)
 ; for entry ien
"RTN","SAMIHOM4",711,0)
 ;
"RTN","SAMIHOM4",712,0)
 n proot set proot=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",713,0)
 n name s name=$g(@proot@(ien,"saminame"))
"RTN","SAMIHOM4",714,0)
 s @proot@("name",name,ien)=""
"RTN","SAMIHOM4",715,0)
 n ucname s ucname=$$UCASE(name)
"RTN","SAMIHOM4",716,0)
 s @proot@("name",ucname,ien)=""
"RTN","SAMIHOM4",717,0)
 n x
"RTN","SAMIHOM4",718,0)
 s x=$g(@proot@(ien,"dfn")) ;w !,x
"RTN","SAMIHOM4",719,0)
 s:x'="" @proot@("dfn",x,ien)=""
"RTN","SAMIHOM4",720,0)
 s x=$g(@proot@(ien,"last5")) ;w !,x
"RTN","SAMIHOM4",721,0)
 s:x'="" @proot@("last5",x,ien)=""
"RTN","SAMIHOM4",722,0)
 s x=$g(@proot@(ien,"icn")) ;w !,x
"RTN","SAMIHOM4",723,0)
 i x'["V" d  ;
"RTN","SAMIHOM4",724,0)
 . i x="" q
"RTN","SAMIHOM4",725,0)
 . n chk s chk=$$CHECKDG^MPIFSPC(x)
"RTN","SAMIHOM4",726,0)
 . s @proot@(ien,"icn")=x_"V"_chk
"RTN","SAMIHOM4",727,0)
 . s x=x_"V"_chk
"RTN","SAMIHOM4",728,0)
 s:x'="" @proot@("icn",x,ien)=""
"RTN","SAMIHOM4",729,0)
 s x=$g(@proot@(ien,"ssn")) ;w !,x
"RTN","SAMIHOM4",730,0)
 s:x'="" @proot@("ssn",x,ien)=""
"RTN","SAMIHOM4",731,0)
 s x=$g(@proot@(ien,"sinamef")) ;w !,x
"RTN","SAMIHOM4",732,0)
 s:x'="" @proot@("sinamef",x,ien)=""
"RTN","SAMIHOM4",733,0)
 s x=$g(@proot@(ien,"sinamel")) w !,x
"RTN","SAMIHOM4",734,0)
 s:x'="" @proot@("sinamel",x,ien)=""
"RTN","SAMIHOM4",735,0)
 set @proot@("Date Last Updated")=$$HTE^XLFDT($horolog)
"RTN","SAMIHOM4",736,0)
 ;
"RTN","SAMIHOM4",737,0)
 quit  ; end of INDXPTLK
"RTN","SAMIHOM4",738,0)
 ;
"RTN","SAMIHOM4",739,0)
 ;
"RTN","SAMIHOM4",740,0)
 ;
"RTN","SAMIHOM4",741,0)
UNINDXPT(ien) ; remove index entries from patient-lookup graph
"RTN","SAMIHOM4",742,0)
 ;
"RTN","SAMIHOM4",743,0)
 ; for entry ien
"RTN","SAMIHOM4",744,0)
 ;
"RTN","SAMIHOM4",745,0)
 n proot set proot=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",746,0)
 n name s name=$g(@proot@(ien,"saminame"))
"RTN","SAMIHOM4",747,0)
 k @proot@("name",name,ien)
"RTN","SAMIHOM4",748,0)
 n ucname s ucname=$$UCASE(name)
"RTN","SAMIHOM4",749,0)
 k @proot@("name",ucname,ien)
"RTN","SAMIHOM4",750,0)
 n x
"RTN","SAMIHOM4",751,0)
 s x=$g(@proot@(ien,"dfn")) ;w !,x
"RTN","SAMIHOM4",752,0)
 k:x'="" @proot@("dfn",x,ien)
"RTN","SAMIHOM4",753,0)
 s x=$g(@proot@(ien,"last5")) ;w !,x
"RTN","SAMIHOM4",754,0)
 k:x'="" @proot@("last5",x,ien)
"RTN","SAMIHOM4",755,0)
 s x=$g(@proot@(ien,"icn")) ;w !,x
"RTN","SAMIHOM4",756,0)
 i x'["V" d  ;
"RTN","SAMIHOM4",757,0)
 . i x="" q
"RTN","SAMIHOM4",758,0)
 . n chk s chk=$$CHECKDG^MPIFSPC(x)
"RTN","SAMIHOM4",759,0)
 . s @proot@(ien,"icn")=x_"V"_chk
"RTN","SAMIHOM4",760,0)
 . s x=x_"V"_chk
"RTN","SAMIHOM4",761,0)
 k:x'="" @proot@("icn",x,ien)
"RTN","SAMIHOM4",762,0)
 s x=$g(@proot@(ien,"ssn")) ;w !,x
"RTN","SAMIHOM4",763,0)
 k:x'="" @proot@("ssn",x,ien)
"RTN","SAMIHOM4",764,0)
 s x=$g(@proot@(ien,"sinamef")) ;w !,x
"RTN","SAMIHOM4",765,0)
 k:x'="" @proot@("sinamef",x,ien)
"RTN","SAMIHOM4",766,0)
 s x=$g(@proot@(ien,"sinamel")) w !,x
"RTN","SAMIHOM4",767,0)
 k:x'="" @proot@("sinamel",x,ien)
"RTN","SAMIHOM4",768,0)
 set @proot@("Date Last Updated")=$$HTE^XLFDT($horolog)
"RTN","SAMIHOM4",769,0)
 ;
"RTN","SAMIHOM4",770,0)
 quit  ; end of UNINDXPT
"RTN","SAMIHOM4",771,0)
 ;
"RTN","SAMIHOM4",772,0)
 ;
"RTN","SAMIHOM4",773,0)
 ;
"RTN","SAMIHOM4",774,0)
UCASE(STR) ; extrinsic returns uppercase of STR
"RTN","SAMIHOM4",775,0)
 ;
"RTN","SAMIHOM4",776,0)
 N X,Y
"RTN","SAMIHOM4",777,0)
 S X=STR
"RTN","SAMIHOM4",778,0)
 X ^%ZOSF("UPPERCASE")
"RTN","SAMIHOM4",779,0)
 ;
"RTN","SAMIHOM4",780,0)
 quit Y ; end of $$UCASE
"RTN","SAMIHOM4",781,0)
 ;
"RTN","SAMIHOM4",782,0)
 ;
"RTN","SAMIHOM4",783,0)
 ;
"RTN","SAMIHOM4",784,0)
 ;@wsi-code DEVHOME^SAMIHOM3
"RTN","SAMIHOM4",785,0)
DEVHOME ; temporary home page for development
"RTN","SAMIHOM4",786,0)
 ;
"RTN","SAMIHOM4",787,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMIHOM4",788,0)
 ;
"RTN","SAMIHOM4",789,0)
 ;ven/gpl;private;procedure;
"RTN","SAMIHOM4",790,0)
 ;@signature
"RTN","SAMIHOM4",791,0)
 ; do DEVHOME^SAMIHOM3(SAMIRTN,SAMIFILTER)
"RTN","SAMIHOM4",792,0)
 ;@branches-from
"RTN","SAMIHOM4",793,0)
 ; DEVHOME^SAMIHOM3
"RTN","SAMIHOM4",794,0)
 ;@called-by
"RTN","SAMIHOM4",795,0)
 ; WSHOME
"RTN","SAMIHOM4",796,0)
 ;@calls
"RTN","SAMIHOM4",797,0)
 ; htmltb2^%yottaweb
"RTN","SAMIHOM4",798,0)
 ; PATLIST
"RTN","SAMIHOM4",799,0)
 ; genhtml^%yottautl
"RTN","SAMIHOM4",800,0)
 ; addary^%yottautl
"RTN","SAMIHOM4",801,0)
 ;@input
"RTN","SAMIHOM4",802,0)
 ; SAMIFILTER =
"RTN","SAMIHOM4",803,0)
 ;@output
"RTN","SAMIHOM4",804,0)
 ;.SAMIRTN =
"RTN","SAMIHOM4",805,0)
 ;@examples [tbd]
"RTN","SAMIHOM4",806,0)
 ;@tests [tbd]
"RTN","SAMIHOM4",807,0)
 ;
"RTN","SAMIHOM4",808,0)
 ;@stanza 2 ?
"RTN","SAMIHOM4",809,0)
 ;
"RTN","SAMIHOM4",810,0)
 new gtop,gbot
"RTN","SAMIHOM4",811,0)
 do htmltb2^%yottaweb(.gtop,.gbot,"SAMI Test Patients")
"RTN","SAMIHOM4",812,0)
 ;
"RTN","SAMIHOM4",813,0)
 new html,ary,hpat
"RTN","SAMIHOM4",814,0)
 do PATLIST^SAMIHOM3("hpat")
"RTN","SAMIHOM4",815,0)
 quit:'$data(hpat)
"RTN","SAMIHOM4",816,0)
 ;
"RTN","SAMIHOM4",817,0)
 set ary("title")="SAMI Test Patients on this system"
"RTN","SAMIHOM4",818,0)
 set ary("header",1)="StudyId"
"RTN","SAMIHOM4",819,0)
 set ary("header",2)="Name"
"RTN","SAMIHOM4",820,0)
 ;
"RTN","SAMIHOM4",821,0)
 new cnt set cnt=0
"RTN","SAMIHOM4",822,0)
 new zi set zi=""
"RTN","SAMIHOM4",823,0)
 for  set zi=$order(hpat(zi)) quit:zi=""  do  ;
"RTN","SAMIHOM4",824,0)
 . set cnt=cnt+1
"RTN","SAMIHOM4",825,0)
 . new url set url="<a href=""/cform.cgi?studyId="_zi_""">"_zi_"</a>"
"RTN","SAMIHOM4",826,0)
 . set ary(cnt,1)=url
"RTN","SAMIHOM4",827,0)
 . set ary(cnt,2)=""
"RTN","SAMIHOM4",828,0)
 . quit
"RTN","SAMIHOM4",829,0)
 ;
"RTN","SAMIHOM4",830,0)
 do genhtml^%yottautl("html","ary")
"RTN","SAMIHOM4",831,0)
 ;
"RTN","SAMIHOM4",832,0)
 do addary^%yottautl("SAMIRTN","gtop")
"RTN","SAMIHOM4",833,0)
 do addary^%yottautl("SAMIRTN","html")
"RTN","SAMIHOM4",834,0)
 set SAMIRTN($order(SAMIRTN(""),-1)+1)=gbot
"RTN","SAMIHOM4",835,0)
 kill SAMIRTN(0)
"RTN","SAMIHOM4",836,0)
 ;
"RTN","SAMIHOM4",837,0)
 set HTTPRSP("mime")="text/html"
"RTN","SAMIHOM4",838,0)
 ;
"RTN","SAMIHOM4",839,0)
 ;@stanza ? termination
"RTN","SAMIHOM4",840,0)
 ;
"RTN","SAMIHOM4",841,0)
 quit  ; end of wsi DEVHOME^SAMIHOM3
"RTN","SAMIHOM4",842,0)
 ;
"RTN","SAMIHOM4",843,0)
 ;
"RTN","SAMIHOM4",844,0)
 ;
"RTN","SAMIHOM4",845,0)
 ;@wsi-code GETHOME^SAMIHOM3
"RTN","SAMIHOM4",846,0)
GETHOME ; homepage accessed using GET
"RTN","SAMIHOM4",847,0)
 ;
"RTN","SAMIHOM4",848,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMIHOM4",849,0)
 ;
"RTN","SAMIHOM4",850,0)
 ;ven/gpl;private;procedure;
"RTN","SAMIHOM4",851,0)
 ;@signature
"RTN","SAMIHOM4",852,0)
 ; do GETHOME^SAMIHOM3(SAMIRTN,SAMIFILTER)
"RTN","SAMIHOM4",853,0)
 ;@branches-from
"RTN","SAMIHOM4",854,0)
 ; GETHOME^SAMIHOM3
"RTN","SAMIHOM4",855,0)
 ;@called-by
"RTN","SAMIHOM4",856,0)
 ; WSHOME
"RTN","SAMIHOM4",857,0)
 ; WSNEWCAS
"RTN","SAMIHOM4",858,0)
 ; WSNFPOST^SAMICASE
"RTN","SAMIHOM4",859,0)
 ; wsLookup^SAMISRCH
"RTN","SAMIHOM4",860,0)
 ;@calls
"RTN","SAMIHOM4",861,0)
 ; GETTMPL^SAMICASE
"RTN","SAMIHOM4",862,0)
 ; findReplace^%ts
"RTN","SAMIHOM4",863,0)
 ; $$SCANFOR
"RTN","SAMIHOM4",864,0)
 ; ADDCRLF^VPRJRUT
"RTN","SAMIHOM4",865,0)
 ;@input
"RTN","SAMIHOM4",866,0)
 ; SAMIFILTER =
"RTN","SAMIHOM4",867,0)
 ;@output
"RTN","SAMIHOM4",868,0)
 ;.SAMIRTN =
"RTN","SAMIHOM4",869,0)
 ;@examples [tbd]
"RTN","SAMIHOM4",870,0)
 ;@tests [tbd]
"RTN","SAMIHOM4",871,0)
 ;
"RTN","SAMIHOM4",872,0)
 ;@stanza 2 get template for homepage
"RTN","SAMIHOM4",873,0)
 ;
"RTN","SAMIHOM4",874,0)
 ; Processing for multi-tenancy
"RTN","SAMIHOM4",875,0)
 ;
"RTN","SAMIHOM4",876,0)
 if $G(SAMIFILTER("siteid"))="" if '$$FINDSITE^SAMISITE(.SAMIRTN,.SAMIFILTER) Q 0
"RTN","SAMIHOM4",877,0)
 new SAMISITE,SAMITITL
"RTN","SAMIHOM4",878,0)
 s SAMISITE=$G(SAMIFILTER("siteid"))
"RTN","SAMIHOM4",879,0)
 s SAMITITL=$G(SAMIFILTER("sitetitle"))
"RTN","SAMIHOM4",880,0)
 ;
"RTN","SAMIHOM4",881,0)
 new temp,tout,form
"RTN","SAMIHOM4",882,0)
 s form="vapals:home"
"RTN","SAMIHOM4",883,0)
 do GETTMPL^SAMICASE("temp",form)
"RTN","SAMIHOM4",884,0)
 quit:'$data(temp)
"RTN","SAMIHOM4",885,0)
 ;
"RTN","SAMIHOM4",886,0)
 ;@stanza 3 process homepage template
"RTN","SAMIHOM4",887,0)
 ;
"RTN","SAMIHOM4",888,0)
 n err
"RTN","SAMIHOM4",889,0)
 do MERGEHTM^%wf(.temp,.SAMIFILTER,.err)
"RTN","SAMIHOM4",890,0)
 ;
"RTN","SAMIHOM4",891,0)
 ;
"RTN","SAMIHOM4",892,0)
 do ADDCRLF^VPRJRUT(.temp)
"RTN","SAMIHOM4",893,0)
 merge SAMIRTN=temp
"RTN","SAMIHOM4",894,0)
 ;
"RTN","SAMIHOM4",895,0)
 quit  ; below is redacted
"RTN","SAMIHOM4",896,0)
 ;
"RTN","SAMIHOM4",897,0)
 ; 
"RTN","SAMIHOM4",898,0)
 new cnt set cnt=0
"RTN","SAMIHOM4",899,0)
 new zi set zi=0
"RTN","SAMIHOM4",900,0)
 for  set zi=$order(temp(zi)) quit:+zi=0  do  ;
"RTN","SAMIHOM4",901,0)
 . ;
"RTN","SAMIHOM4",902,0)
 . n ln s ln=temp(zi)
"RTN","SAMIHOM4",903,0)
 . n touched s touched=0
"RTN","SAMIHOM4",904,0)
 . ;
"RTN","SAMIHOM4",905,0)
 . i ln["href" i 'touched d  ;
"RTN","SAMIHOM4",906,0)
 . . d FIXHREF^SAMIFORM(.ln)
"RTN","SAMIHOM4",907,0)
 . . s temp(zi)=ln
"RTN","SAMIHOM4",908,0)
 . ;
"RTN","SAMIHOM4",909,0)
 . i ln["src" d  ;
"RTN","SAMIHOM4",910,0)
 . . d FIXSRC^SAMIFORM(.ln)
"RTN","SAMIHOM4",911,0)
 . . s temp(zi)=ln
"RTN","SAMIHOM4",912,0)
 . ;
"RTN","SAMIHOM4",913,0)
 . i ln["id" i ln["studyIdMenu" d  ;
"RTN","SAMIHOM4",914,0)
 . . s zi=zi+4
"RTN","SAMIHOM4",915,0)
 . ;
"RTN","SAMIHOM4",916,0)
 . if ln["@@MANUALREGISTRATION@@" do  ; turn off manual registration
"RTN","SAMIHOM4",917,0)
 . . n setman,setparm
"RTN","SAMIHOM4",918,0)
 . . s setman="true"
"RTN","SAMIHOM4",919,0)
 . . s setparm=$$GET^XPAR("SYS","SAMI ALLOW MANUAL ENTRY",,"Q")
"RTN","SAMIHOM4",920,0)
 . . i setparm=0 s setman="false"
"RTN","SAMIHOM4",921,0)
 . . do findReplace^%ts(.ln,"@@MANUALREGISTRATION@@",setman)
"RTN","SAMIHOM4",922,0)
 . . s temp(zi)=ln
"RTN","SAMIHOM4",923,0)
 . . quit 
"RTN","SAMIHOM4",924,0)
 . set cnt=cnt+1
"RTN","SAMIHOM4",925,0)
 . set tout(cnt)=temp(zi)
"RTN","SAMIHOM4",926,0)
 . quit
"RTN","SAMIHOM4",927,0)
 ;
"RTN","SAMIHOM4",928,0)
 ;@stanza 4 add cr/lf & save to return array
"RTN","SAMIHOM4",929,0)
 ;
"RTN","SAMIHOM4",930,0)
 do ADDCRLF^VPRJRUT(.tout)
"RTN","SAMIHOM4",931,0)
 merge SAMIRTN=tout
"RTN","SAMIHOM4",932,0)
 ;
"RTN","SAMIHOM4",933,0)
 ;@stanza 5 termination
"RTN","SAMIHOM4",934,0)
 ;
"RTN","SAMIHOM4",935,0)
 quit  ; end of wsi GETHOME^SAMIHOM3
"RTN","SAMIHOM4",936,0)
 ;
"RTN","SAMIHOM4",937,0)
 ;
"RTN","SAMIHOM4",938,0)
 ;
"RTN","SAMIHOM4",939,0)
 ;@wsi-code WSNEWCAS^SAMIHOM3
"RTN","SAMIHOM4",940,0)
WSNEWCAS ; receives post from home & creates new case
"RTN","SAMIHOM4",941,0)
 ;
"RTN","SAMIHOM4",942,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMIHOM4",943,0)
 ;
"RTN","SAMIHOM4",944,0)
 ;ven/gpl;private;procedure;
"RTN","SAMIHOM4",945,0)
 ;@signature
"RTN","SAMIHOM4",946,0)
 ; do WSNEWCAS^SAMIHOM3(SAMIARGS,SAMIBODY,SAMIRESULT)
"RTN","SAMIHOM4",947,0)
 ;@branches-from
"RTN","SAMIHOM4",948,0)
 ; WSNEWCAS^SAMIHOM3
"RTN","SAMIHOM4",949,0)
 ;@called-by
"RTN","SAMIHOM4",950,0)
 ;@calls
"RTN","SAMIHOM4",951,0)
 ; parseBody^%wf
"RTN","SAMIHOM4",952,0)
 ; $$setroot^%wd
"RTN","SAMIHOM4",953,0)
 ; $$NEXTNUM
"RTN","SAMIHOM4",954,0)
 ; $$GENSTDID^SAMIHOM3
"RTN","SAMIHOM4",955,0)
 ; $$NOW^XLFDT
"RTN","SAMIHOM4",956,0)
 ; $$KEYDATE^SAMIHOM3
"RTN","SAMIHOM4",957,0)
 ; $$VALDTNM
"RTN","SAMIHOM4",958,0)
 ; GETHOME
"RTN","SAMIHOM4",959,0)
 ; PREFILL
"RTN","SAMIHOM4",960,0)
 ; MKSBFORM
"RTN","SAMIHOM4",961,0)
 ; MKSIFORM^SAMIHOM3
"RTN","SAMIHOM4",962,0)
 ; WSCASE^SAMICASE
"RTN","SAMIHOM4",963,0)
 ;@input
"RTN","SAMIHOM4",964,0)
 ;.ARGS =
"RTN","SAMIHOM4",965,0)
 ; BODY =
"RTN","SAMIHOM4",966,0)
 ;.RESULT =
"RTN","SAMIHOM4",967,0)
 ;@output: ?
"RTN","SAMIHOM4",968,0)
 ;@examples [tbd]
"RTN","SAMIHOM4",969,0)
 ;@tests [tbd]
"RTN","SAMIHOM4",970,0)
 ;
"RTN","SAMIHOM4",971,0)
 ;@stanza 2 ?
"RTN","SAMIHOM4",972,0)
 ;
"RTN","SAMIHOM4",973,0)
 merge ^SAMIUL("newCase","ARGS")=SAMIARGS
"RTN","SAMIHOM4",974,0)
 merge ^SAMIUL("newCase","BODY")=SAMIBODY
"RTN","SAMIHOM4",975,0)
 ;
"RTN","SAMIHOM4",976,0)
 new vars,bdy
"RTN","SAMIHOM4",977,0)
 set SAMIBDY=$get(SAMIBODY(1))
"RTN","SAMIHOM4",978,0)
 do parseBody^%wf("vars",.SAMIBDY)
"RTN","SAMIHOM4",979,0)
 merge ^SAMIUL("newCase","vars")=vars
"RTN","SAMIHOM4",980,0)
 ;
"RTN","SAMIHOM4",981,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMIHOM4",982,0)
 ;
"RTN","SAMIHOM4",983,0)
 new saminame set saminame=$get(vars("name"))
"RTN","SAMIHOM4",984,0)
 if saminame="" s saminame=$get(vars("saminame"))
"RTN","SAMIHOM4",985,0)
 ;if $$VALDTNM(saminame,.ARGS)=-1 do  quit  ;
"RTN","SAMIHOM4",986,0)
 ;. new r1
"RTN","SAMIHOM4",987,0)
 ;. do GETHOME(.r1,.ARGS) ; home page to redisplay
"RTN","SAMIHOM4",988,0)
 ;. merge RESULT=r1
"RTN","SAMIHOM4",989,0)
 ;. quit
"RTN","SAMIHOM4",990,0)
 ;
"RTN","SAMIHOM4",991,0)
 new dfn s dfn=$get(vars("dfn"))
"RTN","SAMIHOM4",992,0)
 ;if dfn="" do  quit  ;
"RTN","SAMIHOM4",993,0)
 ;. new r1
"RTN","SAMIHOM4",994,0)
 ;. do GETHOME(.r1,.ARGS) ; home page to redisplay
"RTN","SAMIHOM4",995,0)
 ;. merge RESULT=r1
"RTN","SAMIHOM4",996,0)
 ;. quit
"RTN","SAMIHOM4",997,0)
 ;
"RTN","SAMIHOM4",998,0)
 ;new gien set gien=$$NEXTNUM
"RTN","SAMIHOM4",999,0)
 new gien set gien=dfn
"RTN","SAMIHOM4",1000,0)
 ;
"RTN","SAMIHOM4",1001,0)
 m ^SAMIUL("newCase","G1")=root
"RTN","SAMIHOM4",1002,0)
 ; create dfn index
"RTN","SAMIHOM4",1003,0)
 set @root@("dfn",dfn,gien)=""
"RTN","SAMIHOM4",1004,0)
 ;
"RTN","SAMIHOM4",1005,0)
 set @root@(gien,"saminum")=gien
"RTN","SAMIHOM4",1006,0)
 set @root@(gien,"saminame")=saminame
"RTN","SAMIHOM4",1007,0)
 ;
"RTN","SAMIHOM4",1008,0)
 new studyid set studyid=$$GENSTDID^SAMIHOM3(gien,.SAMIARGS)
"RTN","SAMIHOM4",1009,0)
 set @root@(gien,"samistudyid")=studyid
"RTN","SAMIHOM4",1010,0)
 set @root@("sid",studyid,gien)=""
"RTN","SAMIHOM4",1011,0)
 ;
"RTN","SAMIHOM4",1012,0)
 new datekey set datekey=$$KEYDATE^SAMIHOM3($$NOW^XLFDT)
"RTN","SAMIHOM4",1013,0)
 set @root@(gien,"samicreatedate")=datekey
"RTN","SAMIHOM4",1014,0)
 ;
"RTN","SAMIHOM4",1015,0)
 merge ^SAMIUL("newCase",gien)=@root@(gien)
"RTN","SAMIHOM4",1016,0)
 ;
"RTN","SAMIHOM4",1017,0)
 ;
"RTN","SAMIHOM4",1018,0)
 do PREFILL^SAMIHOM3(dfn) ; prefills from the "patient-lookup" graph
"RTN","SAMIHOM4",1019,0)
 ;
"RTN","SAMIHOM4",1020,0)
 n siformkey
"RTN","SAMIHOM4",1021,0)
 ;do makeSbform(gien) ; create a background form for new patient
"RTN","SAMIHOM4",1022,0)
 set siformkey=$$MKSIFORM^SAMIHOM3(gien) ; create an intake for for new patient
"RTN","SAMIHOM4",1023,0)
 ;
"RTN","SAMIHOM4",1024,0)
 set SAMIARGS("studyid")=studyid
"RTN","SAMIHOM4",1025,0)
 set SAMIARGS("form")="vapals:"_siformkey
"RTN","SAMIHOM4",1026,0)
 do wsGetForm^%wf(.SAMIRESULT,.SAMIARGS)
"RTN","SAMIHOM4",1027,0)
 ;do WSCASE^SAMICASE(.SAMIRESULT,.SAMIARGS) ; navigate to the case review page
"RTN","SAMIHOM4",1028,0)
 ;
"RTN","SAMIHOM4",1029,0)
 ;@stanza ? termination
"RTN","SAMIHOM4",1030,0)
 ;
"RTN","SAMIHOM4",1031,0)
 quit  ; end of wsi WSNEWCAS^SAMIHOM3
"RTN","SAMIHOM4",1032,0)
 ;
"RTN","SAMIHOM4",1033,0)
 ;
"RTN","SAMIHOM4",1034,0)
 ;
"RTN","SAMIHOM4",1035,0)
EOR ; End of routine SAMIHOM4
"RTN","SAMIHUL")
0^6^B95115
"RTN","SAMIHUL",1,0)
SAMIHUL ;ven/gpl - ielcap: home page log ;2021-03-17T18:34Z
"RTN","SAMIHUL",2,0)
 ;;18.0;SAMI;**9**;;Build 5
"RTN","SAMIHUL",3,0)
 ;;1.18.0.9-i9
"RTN","SAMIHUL",4,0)
 ;
"RTN","SAMIHUL",5,0)
 ; SAMIHOME contains subroutines for producing the ELCAP Home Page.
"RTN","SAMIHUL",6,0)
 ; SAMIHUL contains the development log for the SAMIHOM* routines.
"RTN","SAMIHUL",7,0)
 ; It contains no executable code.
"RTN","SAMIHUL",8,0)
 ;
"RTN","SAMIHUL",9,0)
 quit  ; no entry from top
"RTN","SAMIHUL",10,0)
 ;
"RTN","SAMIHUL",11,0)
 ;
"RTN","SAMIHUL",12,0)
 ;
"RTN","SAMIHUL",13,0)
 ;@section 0 primary development
"RTN","SAMIHUL",14,0)
 ;
"RTN","SAMIHUL",15,0)
 ;
"RTN","SAMIHUL",16,0)
 ;
"RTN","SAMIHUL",17,0)
 ;@routine-credits
"RTN","SAMIHUL",18,0)
 ;@primary-dev George P. Lilly (gpl)
"RTN","SAMIHUL",19,0)
 ; gpl@vistaexpertise.net
"RTN","SAMIHUL",20,0)
 ;@primary-dev-org Vista Expertise Network (ven)
"RTN","SAMIHUL",21,0)
 ; http://vistaexpertise.net
"RTN","SAMIHUL",22,0)
 ;@copyright 2017/2021, gpl, all rights reserved
"RTN","SAMIHUL",23,0)
 ;@license see routine SAMIUL
"RTN","SAMIHUL",24,0)
 ;
"RTN","SAMIHUL",25,0)
 ;@last-updated 2021-03-17T18:34Z
"RTN","SAMIHUL",26,0)
 ;@application Screening Applications Management (SAM)
"RTN","SAMIHUL",27,0)
 ;@module Screening Applications Management - IELCAP (SAMI)
"RTN","SAMIHUL",28,0)
 ;@suite-of-files SAMI Forms (311.101-311.199)
"RTN","SAMIHUL",29,0)
 ;@version 1.18.0.9-i9
"RTN","SAMIHUL",30,0)
 ;@release-date 2020-01
"RTN","SAMIHUL",31,0)
 ;@patch-list **9**
"RTN","SAMIHUL",32,0)
 ;
"RTN","SAMIHUL",33,0)
 ;@additional-dev Frederick D. S. Marshall (toad)
"RTN","SAMIHUL",34,0)
 ; toad@vistaexpertise.net
"RTN","SAMIHUL",35,0)
 ;@additional-dev Linda M. R. Yaw (lmry)
"RTN","SAMIHUL",36,0)
 ; linda.yaw@vistaexpertise.net
"RTN","SAMIHUL",37,0)
 ;@additional-dev Larry G. Carlson (lgc)
"RTN","SAMIHUL",38,0)
 ; larry.g.carlson@gmail.com
"RTN","SAMIHUL",39,0)
 ;@additional-dev Alexis R. Carlson (arc)
"RTN","SAMIHUL",40,0)
 ; whatisthehumanspirit@gmail.com
"RTN","SAMIHUL",41,0)
 ;@additional-dev Domenick DiNatale (ddn)
"RTN","SAMIHUL",42,0)
 ; domenic@intellitechinnovations.com
"RTN","SAMIHUL",43,0)
 ;
"RTN","SAMIHUL",44,0)
 ;@module-credits
"RTN","SAMIHUL",45,0)
 ;@project VA Partnership to Increase Access to Lung Screening
"RTN","SAMIHUL",46,0)
 ; (VA-PALS)
"RTN","SAMIHUL",47,0)
 ; http://va-pals.org/
"RTN","SAMIHUL",48,0)
 ;@funding 2017/2021, Bristol-Myers Squibb Foundation (bmsf)
"RTN","SAMIHUL",49,0)
 ; https://www.bms.com/about-us/responsibility/bristol-myers-squibb-foundation.html
"RTN","SAMIHUL",50,0)
 ;@partner-org Veterans Affairs Office of Rural health
"RTN","SAMIHUL",51,0)
 ; https://www.ruralhealth.va.gov/
"RTN","SAMIHUL",52,0)
 ;@partner-org International Early Lung Cancer Action Program (I-ELCAP)
"RTN","SAMIHUL",53,0)
 ; http://ielcap.com/
"RTN","SAMIHUL",54,0)
 ;@partner-org Paraxial Technologies (par)
"RTN","SAMIHUL",55,0)
 ; http://paraxialtech.com/
"RTN","SAMIHUL",56,0)
 ;@partner-org Open Source Electronic Health Record Alliance (OSEHRA)
"RTN","SAMIHUL",57,0)
 ; https://www.osehra.org/groups/va-pals-open-source-project-group
"RTN","SAMIHUL",58,0)
 ;
"RTN","SAMIHUL",59,0)
 ;@module-log repo github.com:VA-PALS-ELCAP/SAMI-VAPALS-ELCAP.git
"RTN","SAMIHUL",60,0)
 ;
"RTN","SAMIHUL",61,0)
 ; 2018-12-18/20 ven/arc 1.18.0-t04 3088307f,4271b46b,dfbb0bca,
"RTN","SAMIHUL",62,0)
 ;  b8ff6da9,fd1bceee
"RTN","SAMIHUL",63,0)
 ;  SAMIHOM4: va sac compliance & variable namespacing.
"RTN","SAMIHUL",64,0)
 ;
"RTN","SAMIHUL",65,0)
 ; 2019-01-01/02-18 ven/lgc 1.18.0-t04 0880027c,18aa0fec,fcd635c1,
"RTN","SAMIHUL",66,0)
 ;  53681219,76874314
"RTN","SAMIHUL",67,0)
 ;  SAMIHOM4: updates for va sac & code coverage, add license info.
"RTN","SAMIHUL",68,0)
 ;
"RTN","SAMIHUL",69,0)
 ; 2019-04-15 ven/gpl 1.18.0-t04 b403bf01
"RTN","SAMIHUL",70,0)
 ;  SAMIHOM4: support for new intake notes.
"RTN","SAMIHUL",71,0)
 ;
"RTN","SAMIHUL",72,0)
 ; 2019-04-16 ven/lgc 1.18.0-t04 e54b76d1
"RTN","SAMIHUL",73,0)
 ;  SAMIHOM4: update for SAMIFORM project.
"RTN","SAMIHUL",74,0)
 ;
"RTN","SAMIHUL",75,0)
 ; 2019-06-18 ven/arc 1.18.0-t04 91022482
"RTN","SAMIHUL",76,0)
 ;  SAMIHOM4: switch fr/global ^SAMIGPL to/^SAMIUL.
"RTN","SAMIHUL",77,0)
 ;
"RTN","SAMIHUL",78,0)
 ; 2019-11-22 par/ddn 1.18.0-t04 b2cc389d vap-458
"RTN","SAMIHUL",79,0)
 ;  SAMIHOM4: manual registration.
"RTN","SAMIHUL",80,0)
 ;
"RTN","SAMIHUL",81,0)
 ; 2020-01-01/05 ven/lgc 1.18.0 c169f4b1,5928064a,62e3200f
"RTN","SAMIHUL",82,0)
 ;  SAMIHOM4: support for unmatched patient processing, more changes
"RTN","SAMIHUL",83,0)
 ; for participant matching, unmatched participant processing ready
"RTN","SAMIHUL",84,0)
 ; for testing.
"RTN","SAMIHUL",85,0)
 ;
"RTN","SAMIHUL",86,0)
 ; 2020-01-08/10 ven/gpl 1.18.0 a002f850,47dfe3cd
"RTN","SAMIHUL",87,0)
 ;  SAMIHOM4: bug fix for unmatched processing, turn off & on manual
"RTN","SAMIHUL",88,0)
 ; registration link on home page.
"RTN","SAMIHUL",89,0)
 ;
"RTN","SAMIHUL",90,0)
 ; 2020-01-10 ven/gpl 1.18.0 4c8e6ebc,76b465cb
"RTN","SAMIHUL",91,0)
 ;  SAMIHOM4: 3 quits with returns for cache.
"RTN","SAMIHUL",92,0)
 ;
"RTN","SAMIHUL",93,0)
 ; 2020-01-16 ven/lgc 1.18.0 0a2af965
"RTN","SAMIHUL",94,0)
 ;  SAMIHOM4: bulk commit due to switch to cache.
"RTN","SAMIHUL",95,0)
 ;
"RTN","SAMIHUL",96,0)
 ; 2020-01-17/20 ven/lgc 1.18.0.1-i1 8557207f,dc5f618c
"RTN","SAMIHUL",97,0)
 ;  SAMIHOM4: followup note, limit to one note per followup form.
"RTN","SAMIHUL",98,0)
 ;
"RTN","SAMIHUL",99,0)
 ; 2020-02-01/02 ven/lgc 1.18.0.4-i4 3065146d,36ae0ed1
"RTN","SAMIHUL",100,0)
 ;  SAMIHOM4: set options for text based ctreport, switch default
"RTN","SAMIHUL",101,0)
 ; ctreport to text.
"RTN","SAMIHUL",102,0)
 ;
"RTN","SAMIHUL",103,0)
 ; 2020-04-02/11 ven/gpl 1.18.0.5-i5 d36b7cad,36607664,befde317,
"RTN","SAMIHUL",104,0)
 ;  56bfaed6,666f5b91,2f2c29c1
"RTN","SAMIHUL",105,0)
 ;  SAMIHOM4: multitenancy + fix bug in WSVAPALS.
"RTN","SAMIHUL",106,0)
 ;
"RTN","SAMIHUL",107,0)
 ; 2020-04-18/05-07 ven/gpl 1.18.0.5-i5 29d7dba7,d55de214,521e0bdc,
"RTN","SAMIHUL",108,0)
 ;  d018f52e,476b2ff4,61c7d208
"RTN","SAMIHUL",109,0)
 ;  SAMIHOM4: fix bug & weird error in manual registration, fix bug in
"RTN","SAMIHUL",110,0)
 ; logout, logout working, superuser site selection, worklist
"RTN","SAMIHUL",111,0)
 ; functionality.
"RTN","SAMIHUL",112,0)
 ;
"RTN","SAMIHUL",113,0)
 ; 2020-08-06 ven/gpl 1.18.0.6-i6 781744c3
"RTN","SAMIHUL",114,0)
 ;  SAMIHOM4: changes to support hl7 transmission of notes.
"RTN","SAMIHUL",115,0)
 ;
"RTN","SAMIHUL",116,0)
 ; 2020-09-22 ven/gpl 1.18.0.9-i9 06459eda
"RTN","SAMIHUL",117,0)
 ;  SAMIHOM4: correct to match kids file.
"RTN","SAMIHUL",118,0)
 ;
"RTN","SAMIHUL",119,0)
 ; 2021-03-02 ven/gpl 1.18.0.9-i9 479dc041
"RTN","SAMIHUL",120,0)
 ;  SAMIHOM4: return error message if no ct eval form exists when
"RTN","SAMIHUL",121,0)
 ; generating a fu note.
"RTN","SAMIHUL",122,0)
 ;
"RTN","SAMIHUL",123,0)
 ; 2021-03-11 ven/toad 1.18.0.9-i9 a46a2cc1
"RTN","SAMIHUL",124,0)
 ;  SAMIHUL: create routine.
"RTN","SAMIHUL",125,0)
 ;  SAMIHOM4: bump date & patch list, add contents, lt refactor.
"RTN","SAMIHUL",126,0)
 ;
"RTN","SAMIHUL",127,0)
 ; 2021-03-17 ven/toad 1.18.0.9-i9
"RTN","SAMIHUL",128,0)
 ; SAMIHOM4: remove blank from end of 1 line.
"RTN","SAMIHUL",129,0)
 ;
"RTN","SAMIHUL",130,0)
 ;
"RTN","SAMIHUL",131,0)
 ;
"RTN","SAMIHUL",132,0)
EOR ; end of routine SAMIHUL
"RTN","SAMINOT2")
0^3^B463867017
"RTN","SAMINOT2",1,0)
SAMINOT2 ;ven/gpl - followup form notes ;2021-03-17T18:33Z
"RTN","SAMINOT2",2,0)
 ;;18.0;SAMI;**1,9**;;Build 5
"RTN","SAMINOT2",3,0)
 ;;1.18.0.9-i9
"RTN","SAMINOT2",4,0)
 ;
"RTN","SAMINOT2",5,0)
 ; SAMINOT2 contains web services & other subroutines for producing
"RTN","SAMINOT2",6,0)
 ; the ELCAP Followup Form Notes.
"RTN","SAMINOT2",7,0)
 ;
"RTN","SAMINOT2",8,0)
 quit  ; no entry from top
"RTN","SAMINOT2",9,0)
 ;
"RTN","SAMINOT2",10,0)
 ;
"RTN","SAMINOT2",11,0)
 ;
"RTN","SAMINOT2",12,0)
 ;@section 0 primary development
"RTN","SAMINOT2",13,0)
 ;
"RTN","SAMINOT2",14,0)
 ;
"RTN","SAMINOT2",15,0)
 ;
"RTN","SAMINOT2",16,0)
 ;@license see routine SAMIUL
"RTN","SAMINOT2",17,0)
 ;@documentation see SAMICUL
"RTN","SAMINOT2",18,0)
 ;@contents
"RTN","SAMINOT2",19,0)
 ; WSNOTE: web service to return text note
"RTN","SAMINOT2",20,0)
 ; $$NOTE = create note
"RTN","SAMINOT2",21,0)
 ; $$HASINNT = is intake note present?
"RTN","SAMINOT2",22,0)
 ; $$HASVCNT = is communication note present?
"RTN","SAMINOT2",23,0)
 ; $$HASLCSNT = is lung cancer screening note present?
"RTN","SAMINOT2",24,0)
 ; MKVC: make communication note
"RTN","SAMINOT2",25,0)
 ; MKLCS: make lung cancer screening note
"RTN","SAMINOT2",26,0)
 ; $$MKNT: make note w/date=now
"RTN","SAMINOT2",27,0)
 ; $$MKNTLOC: make note
"RTN","SAMINOT2",28,0)
 ; $$NTDTTM = convert date/time fr/fm to/note format
"RTN","SAMINOT2",29,0)
 ; $$NTLOCN = location of nth note
"RTN","SAMINOT2",30,0)
 ; $$NTLAST = location of latest note of a type
"RTN","SAMINOT2",31,0)
 ; NTLIST: return note list
"RTN","SAMINOT2",32,0)
 ; TLST: test NTLIST
"RTN","SAMINOT2",33,0)
 ; VCNOTE: veteran communication note
"RTN","SAMINOT2",34,0)
 ; SSTATUS: smoking status
"RTN","SAMINOT2",35,0)
 ; LCSNOTE: lung cancer screening note
"RTN","SAMINOT2",36,0)
 ; OUT: output new line to note
"RTN","SAMINOT2",37,0)
 ; $$XVAL = value of form variable
"RTN","SAMINOT2",38,0)
 ; $$PREVCT = key to previous ct eval form
"RTN","SAMINOT2",39,0)
 ; CTINFO: extracts from latest ct eval form
"RTN","SAMINOT2",40,0)
 ; IMPRESS: impressions from ct eval report
"RTN","SAMINOT2",41,0)
 ; $$XSUB = dictionary value for variable
"RTN","SAMINOT2",42,0)
 ;
"RTN","SAMINOT2",43,0)
 ;
"RTN","SAMINOT2",44,0)
 ;
"RTN","SAMINOT2",45,0)
 ;@section 1 wsi WSNOTE & related subroutines
"RTN","SAMINOT2",46,0)
 ;
"RTN","SAMINOT2",47,0)
 ;
"RTN","SAMINOT2",48,0)
 ;
"RTN","SAMINOT2",49,0)
 ;@wsi WSNOTE^SAMINOT2, vapals-elcap followup note
"RTN","SAMINOT2",50,0)
WSNOTE(return,filter) ; web service to return text note
"RTN","SAMINOT2",51,0)
 ;
"RTN","SAMINOT2",52,0)
 ;ven/gpl;web service;procedure;
"RTN","SAMINOT2",53,0)
 ;
"RTN","SAMINOT2",54,0)
 n debug s debug=0
"RTN","SAMINOT2",55,0)
 i $g(filter("debug"))=1 s debug=1
"RTN","SAMINOT2",56,0)
 ;
"RTN","SAMINOT2",57,0)
 k return
"RTN","SAMINOT2",58,0)
 s HTTPRSP("mime")="text/html"
"RTN","SAMINOT2",59,0)
 ;
"RTN","SAMINOT2",60,0)
 n si
"RTN","SAMINOT2",61,0)
 s si=$g(filter("studyid"))
"RTN","SAMINOT2",62,0)
 i si="" d  ;
"RTN","SAMINOT2",63,0)
 . s si="XXX00333"
"RTN","SAMINOT2",64,0)
 q:si=""
"RTN","SAMINOT2",65,0)
 ;
"RTN","SAMINOT2",66,0)
 n samikey
"RTN","SAMINOT2",67,0)
 s samikey=$g(filter("form"))
"RTN","SAMINOT2",68,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMINOT2",69,0)
 i samikey="" d  ;
"RTN","SAMINOT2",70,0)
 . s samikey=$o(@root@("graph",si,"siform"))
"RTN","SAMINOT2",71,0)
 . ;w !,samikey
"RTN","SAMINOT2",72,0)
 . ;b
"RTN","SAMINOT2",73,0)
 ;
"RTN","SAMINOT2",74,0)
 n vals
"RTN","SAMINOT2",75,0)
 m vals=@root@("graph",si,samikey)
"RTN","SAMINOT2",76,0)
 ;
"RTN","SAMINOT2",77,0)
 n note,nien,ntype
"RTN","SAMINOT2",78,0)
 s ntype=""
"RTN","SAMINOT2",79,0)
 s note=""
"RTN","SAMINOT2",80,0)
 s nien=$g(filter("nien"))
"RTN","SAMINOT2",81,0)
 i nien="" d
"RTN","SAMINOT2",82,0)
 . s:$g(vals("samistatus"))="complete" ntype="intake"
"RTN","SAMINOT2",83,0)
 . s:$g(vals("samistatus"))="chart-eligibility" ntype="eligibility"
"RTN","SAMINOT2",84,0)
 . s:$g(vals("samistatus"))="pre-enrollment-discussion" ntype="pre-note"
"RTN","SAMINOT2",85,0)
 . q:ntype=""
"RTN","SAMINOT2",86,0)
 . ;d nien=$$NTTYPE add code to pull the latest note by type
"RTN","SAMINOT2",87,0)
 q:nien=""
"RTN","SAMINOT2",88,0)
 n notebase
"RTN","SAMINOT2",89,0)
 s notebase=$$NTLOCN(si,samikey,nien) ; global location for the note
"RTN","SAMINOT2",90,0)
 s note=$na(@notebase@("text"))
"RTN","SAMINOT2",91,0)
 i '$d(@note) q
"RTN","SAMINOT2",92,0)
 ;
"RTN","SAMINOT2",93,0)
 new temp,tout
"RTN","SAMINOT2",94,0)
 do GETTMPL^SAMICASE("temp","vapals:note")
"RTN","SAMINOT2",95,0)
 quit:'$data(temp)
"RTN","SAMINOT2",96,0)
 ;
"RTN","SAMINOT2",97,0)
 n cnt s cnt=0
"RTN","SAMINOT2",98,0)
 n zi s zi=""
"RTN","SAMINOT2",99,0)
 ;
"RTN","SAMINOT2",100,0)
 f  s zi=$o(temp(zi)) q:zi=""  d  ;
"RTN","SAMINOT2",101,0)
 . ;
"RTN","SAMINOT2",102,0)
 . n line s line=temp(zi)
"RTN","SAMINOT2",103,0)
 . D LOAD^SAMIFORM(.line,samikey,si,.filter,.vals)
"RTN","SAMINOT2",104,0)
 . s temp(zi)=line
"RTN","SAMINOT2",105,0)
 . ;
"RTN","SAMINOT2",106,0)
 . s cnt=cnt+1
"RTN","SAMINOT2",107,0)
 . s tout(cnt)=temp(zi)
"RTN","SAMINOT2",108,0)
 . ;
"RTN","SAMINOT2",109,0)
 . i temp(zi)["report-text" d  ;
"RTN","SAMINOT2",110,0)
 . . i temp(zi)["#" q  ;
"RTN","SAMINOT2",111,0)
 . . n zj s zj=""
"RTN","SAMINOT2",112,0)
 . . f  s zj=$o(@note@(zj)) q:zj=""  d  ;
"RTN","SAMINOT2",113,0)
 . . . s cnt=cnt+1
"RTN","SAMINOT2",114,0)
 . . . ;s tout(cnt)=@note@(zj)_"<br>"
"RTN","SAMINOT2",115,0)
 . . . s tout(cnt)=@note@(zj)_$char(13,10)
"RTN","SAMINOT2",116,0)
 m return=tout
"RTN","SAMINOT2",117,0)
 ;
"RTN","SAMINOT2",118,0)
 quit  ; end of wsi WSNOTE^SAMINOT2
"RTN","SAMINOT2",119,0)
 ;
"RTN","SAMINOT2",120,0)
 ;
"RTN","SAMINOT2",121,0)
 ;
"RTN","SAMINOT2",122,0)
NOTE(filter) ; extrnisic to create note
"RTN","SAMINOT2",123,0)
 ;
"RTN","SAMINOT2",124,0)
 ;ven/gpl;private;function;
"RTN","SAMINOT2",125,0)
 ;@output = 1 if successful, 0 if not
"RTN","SAMINOT2",126,0)
 ;
"RTN","SAMINOT2",127,0)
 k ^gpl("funote")
"RTN","SAMINOT2",128,0)
 m ^gpl("funote")=filter
"RTN","SAMINOT2",129,0)
 ;q 0  ; while we are developing
"RTN","SAMINOT2",130,0)
 ;
"RTN","SAMINOT2",131,0)
 ; set up patient values
"RTN","SAMINOT2",132,0)
 ;
"RTN","SAMINOT2",133,0)
 n vals
"RTN","SAMINOT2",134,0)
 ;
"RTN","SAMINOT2",135,0)
 n si
"RTN","SAMINOT2",136,0)
 s si=$g(filter("studyid"))
"RTN","SAMINOT2",137,0)
 q:si="" 0
"RTN","SAMINOT2",138,0)
 ;
"RTN","SAMINOT2",139,0)
 n samikey
"RTN","SAMINOT2",140,0)
 s samikey=$g(filter("form"))
"RTN","SAMINOT2",141,0)
 q:samikey="" 0
"RTN","SAMINOT2",142,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMINOT2",143,0)
 ;
"RTN","SAMINOT2",144,0)
 s vals=$na(@root@("graph",si,samikey))
"RTN","SAMINOT2",145,0)
 ;
"RTN","SAMINOT2",146,0)
 i '$d(@vals) d  q 0 ;
"RTN","SAMINOT2",147,0)
 . ;w !,"error, patient values not found"
"RTN","SAMINOT2",148,0)
 ;zwr @vals@(*)
"RTN","SAMINOT2",149,0)
 ;
"RTN","SAMINOT2",150,0)
 k ^SAMIUL("NOTE")
"RTN","SAMINOT2",151,0)
 m ^SAMIUL("NOTE","vals")=@vals
"RTN","SAMINOT2",152,0)
 m ^SAMIUL("NOTE","filter")=filter
"RTN","SAMINOT2",153,0)
 ;
"RTN","SAMINOT2",154,0)
 n didnote s didnote=0
"RTN","SAMINOT2",155,0)
 ;
"RTN","SAMINOT2",156,0)
 i $d(@vals@("notes")) d  q didnote ;
"RTN","SAMINOT2",157,0)
 . s filter("errorMessage")="Note already exists for this form."
"RTN","SAMINOT2",158,0)
 ;
"RTN","SAMINOT2",159,0)
 i $g(@vals@("futype"))="other" d  ;
"RTN","SAMINOT2",160,0)
 . i $g(@vals@("samistatus"))'="complete" q  ;
"RTN","SAMINOT2",161,0)
 . ;q:$$HASVCNT(vals)
"RTN","SAMINOT2",162,0)
 . d MKVC(si,samikey,vals,.filter) ;
"RTN","SAMINOT2",163,0)
 . s didnote=1
"RTN","SAMINOT2",164,0)
 ;
"RTN","SAMINOT2",165,0)
 i $g(@vals@("futype"))="ct" d  ;
"RTN","SAMINOT2",166,0)
 . i $g(@vals@("samistatus"))'="complete" q  ;
"RTN","SAMINOT2",167,0)
 . ;q:$$HASLCSNT(vals)
"RTN","SAMINOT2",168,0)
 . n ctdt,ctkey
"RTN","SAMINOT2",169,0)
 . s ctdt=$$LASTCMP^SAMICAS3(si,.ctkey)
"RTN","SAMINOT2",170,0)
 . i ctdt=-1 d  q  ;
"RTN","SAMINOT2",171,0)
 . . s filter("errorMessage")="No CT Eval form exists, followup note not created."
"RTN","SAMINOT2",172,0)
 . d MKLCS(si,samikey,vals,.filter) ;
"RTN","SAMINOT2",173,0)
 . s didnote=1
"RTN","SAMINOT2",174,0)
 ;
"RTN","SAMINOT2",175,0)
 ;i $g(@vals@("samistatus"))="complete" d  ;
"RTN","SAMINOT2",176,0)
 ;. q:$$HASVCNT(vals)
"RTN","SAMINOT2",177,0)
 ;. d MKVC(si,samikey,vals,.filter) ;
"RTN","SAMINOT2",178,0)
 ;. s didnote=1
"RTN","SAMINOT2",179,0)
 ;
"RTN","SAMINOT2",180,0)
 quit didnote ; end of $$NOTE
"RTN","SAMINOT2",181,0)
 ;
"RTN","SAMINOT2",182,0)
 ;
"RTN","SAMINOT2",183,0)
 ;
"RTN","SAMINOT2",184,0)
HASINNT(vals) ; is intake note present?
"RTN","SAMINOT2",185,0)
 ;
"RTN","SAMINOT2",186,0)
 ;ven/gpl;private;function;
"RTN","SAMINOT2",187,0)
 ;@output = 1 if intake note is present, 0 if not
"RTN","SAMINOT2",188,0)
 ;
"RTN","SAMINOT2",189,0)
 n zzi,zzrtn s (zzi,zzrtn)=0
"RTN","SAMINOT2",190,0)
 q:'$d(@vals)
"RTN","SAMINOT2",191,0)
 f  s zzi=$o(@vals@("notes",zzi)) q:+zzi=0  d  ;
"RTN","SAMINOT2",192,0)
 . i $g(@vals@("notes",zzi,"name"))["Intake" s zzrtn=1
"RTN","SAMINOT2",193,0)
 ;
"RTN","SAMINOT2",194,0)
 quit zzrtn ; end of $$HASINNT
"RTN","SAMINOT2",195,0)
 ;
"RTN","SAMINOT2",196,0)
 ;
"RTN","SAMINOT2",197,0)
 ;
"RTN","SAMINOT2",198,0)
HASVCNT(vals) ; is communication note present?
"RTN","SAMINOT2",199,0)
 ;
"RTN","SAMINOT2",200,0)
 ;ven/gpl;private;function;
"RTN","SAMINOT2",201,0)
 ;@output = 1 if communication note is present, 0 if not
"RTN","SAMINOT2",202,0)
 ;
"RTN","SAMINOT2",203,0)
 n zzi,zzrtn s (zzi,zzrtn)=0
"RTN","SAMINOT2",204,0)
 q:'$d(@vals)
"RTN","SAMINOT2",205,0)
 f  s zzi=$o(@vals@("notes",zzi)) q:+zzi=0  d  ;
"RTN","SAMINOT2",206,0)
 . i $g(@vals@("notes",zzi,"name"))["Communication" s zzrtn=1
"RTN","SAMINOT2",207,0)
 ;
"RTN","SAMINOT2",208,0)
 quit zzrtn ; end of $$HASVCNT
"RTN","SAMINOT2",209,0)
 ;
"RTN","SAMINOT2",210,0)
 ;
"RTN","SAMINOT2",211,0)
 ;
"RTN","SAMINOT2",212,0)
HASLCSNT(vals) ; is lung cancer screening note present?
"RTN","SAMINOT2",213,0)
 ;
"RTN","SAMINOT2",214,0)
 ;ven/gpl;private;function;
"RTN","SAMINOT2",215,0)
 ;@output = 1 if communication note is present, 0 if not
"RTN","SAMINOT2",216,0)
 ;
"RTN","SAMINOT2",217,0)
 n zzi,zzrtn s (zzi,zzrtn)=0
"RTN","SAMINOT2",218,0)
 q:'$d(@vals)
"RTN","SAMINOT2",219,0)
 f  s zzi=$o(@vals@("notes",zzi)) q:+zzi=0  d  ;
"RTN","SAMINOT2",220,0)
 . i $g(@vals@("notes",zzi,"name"))["Lung" s zzrtn=1
"RTN","SAMINOT2",221,0)
 ;
"RTN","SAMINOT2",222,0)
 quit zzrtn ; end of $$HASLCSNT
"RTN","SAMINOT2",223,0)
 ;
"RTN","SAMINOT2",224,0)
 ;
"RTN","SAMINOT2",225,0)
 ;
"RTN","SAMINOT2",226,0)
MKVC(sid,form,vals,filter) ; make communication note
"RTN","SAMINOT2",227,0)
 ;
"RTN","SAMINOT2",228,0)
 ;ven/gpl;private;procedure;
"RTN","SAMINOT2",229,0)
 ;
"RTN","SAMINOT2",230,0)
 n cnt s cnt=0
"RTN","SAMINOT2",231,0)
 ;n dest s dest=$na(@vals@("communication-note"))
"RTN","SAMINOT2",232,0)
 n dest s dest=$$MKNT(vals,"Communication Note","communication",.filter)
"RTN","SAMINOT2",233,0)
 k @dest
"RTN","SAMINOT2",234,0)
 d OUT("Veteran Communication Note")
"RTN","SAMINOT2",235,0)
 d OUT("")
"RTN","SAMINOT2",236,0)
 d VCNOTE(vals,dest,cnt)
"RTN","SAMINOT2",237,0)
 ;
"RTN","SAMINOT2",238,0)
 quit  ; end of MKVC
"RTN","SAMINOT2",239,0)
 ;
"RTN","SAMINOT2",240,0)
 ;
"RTN","SAMINOT2",241,0)
 ;
"RTN","SAMINOT2",242,0)
MKLCS(sid,form,vals,filter) ; make lung cancer screening note
"RTN","SAMINOT2",243,0)
 ;
"RTN","SAMINOT2",244,0)
 ;ven/gpl;private;procedure;
"RTN","SAMINOT2",245,0)
 ;
"RTN","SAMINOT2",246,0)
 n cnt s cnt=0
"RTN","SAMINOT2",247,0)
 ;n dest s dest=$na(@vals@("lcs-note"))
"RTN","SAMINOT2",248,0)
 n dest s dest=$$MKNT(vals,"Lung Cancer Screening Note","lcs",.filter)
"RTN","SAMINOT2",249,0)
 k @dest
"RTN","SAMINOT2",250,0)
 d OUT("Lung Screening and Surveillance Follow up Note")
"RTN","SAMINOT2",251,0)
 d OUT("")
"RTN","SAMINOT2",252,0)
 d LCSNOTE(vals,dest,cnt)
"RTN","SAMINOT2",253,0)
 ;
"RTN","SAMINOT2",254,0)
 quit  ; end of MKLCS
"RTN","SAMINOT2",255,0)
 ;
"RTN","SAMINOT2",256,0)
 ;
"RTN","SAMINOT2",257,0)
 ;
"RTN","SAMINOT2",258,0)
MKNT(vals,title,ntype,filter) ; make note w/date=now
"RTN","SAMINOT2",259,0)
 ;
"RTN","SAMINOT2",260,0)
 ;ven/gpl;private;pseudo-function;
"RTN","SAMINOT2",261,0)
 ;@input
"RTN","SAMINOT2",262,0)
 ; .filter (passed by reference)
"RTN","SAMINOT2",263,0)
 ;@output = global address
"RTN","SAMINOT2",264,0)
 ;
"RTN","SAMINOT2",265,0)
 n ntdt s ntdt=$$NTDTTM($$NOW^XLFDT)
"RTN","SAMINOT2",266,0)
 n ntptr
"RTN","SAMINOT2",267,0)
 s ntptr=$$MKNTLOC(vals,title,ntdt,$g(ntype),.filter)
"RTN","SAMINOT2",268,0)
 ;
"RTN","SAMINOT2",269,0)
 quit ntptr ; end of $$MKNT
"RTN","SAMINOT2",270,0)
 ;
"RTN","SAMINOT2",271,0)
 ;
"RTN","SAMINOT2",272,0)
 ;
"RTN","SAMINOT2",273,0)
MKNTLOC(vals,title,ndate,ntype,filter) ; make note
"RTN","SAMINOT2",274,0)
 ;
"RTN","SAMINOT2",275,0)
 ;ven/gpl;private;pseudo-function;
"RTN","SAMINOT2",276,0)
 ;@output = note location (global address)
"RTN","SAMINOT2",277,0)
 ;
"RTN","SAMINOT2",278,0)
 n nien
"RTN","SAMINOT2",279,0)
 s nien=$o(@vals@("notes",""),-1)+1
"RTN","SAMINOT2",280,0)
 s filter("nien")=nien
"RTN","SAMINOT2",281,0)
 n nloc s nloc=$na(@vals@("notes",nien))
"RTN","SAMINOT2",282,0)
 s @nloc@("name")=title_" "_$g(ndate)
"RTN","SAMINOT2",283,0)
 s @nloc@("date")=$g(ndate)
"RTN","SAMINOT2",284,0)
 s @nloc@("type")=$g(ntype)
"RTN","SAMINOT2",285,0)
 ;
"RTN","SAMINOT2",286,0)
 quit $na(@nloc@("text"))
"RTN","SAMINOT2",287,0)
 ;
"RTN","SAMINOT2",288,0)
 ;
"RTN","SAMINOT2",289,0)
 ;
"RTN","SAMINOT2",290,0)
NTDTTM(ZFMDT) ; convert date/time fr/fm to/note format
"RTN","SAMINOT2",291,0)
 ;
"RTN","SAMINOT2",292,0)
 ;ven/gpl;private;function;
"RTN","SAMINOT2",293,0)
 ;@input
"RTN","SAMINOT2",294,0)
 ; ZFMDT = fileman date/time to translate
"RTN","SAMINOT2",295,0)
 ;@output = date/time in note format
"RTN","SAMINOT2",296,0)
 ;
"RTN","SAMINOT2",297,0)
 quit $$FMTE^XLFDT(ZFMDT,"5") ; end of $$NTDTTM
"RTN","SAMINOT2",298,0)
 ;
"RTN","SAMINOT2",299,0)
 ;
"RTN","SAMINOT2",300,0)
 ;
"RTN","SAMINOT2",301,0)
NTLOCN(sid,form,nien) ; location of nth note
"RTN","SAMINOT2",302,0)
 ;
"RTN","SAMINOT2",303,0)
 ;ven/gpl;private;function;
"RTN","SAMINOT2",304,0)
 ;@output = global location of Nth note
"RTN","SAMINOT2",305,0)
 ;
"RTN","SAMINOT2",306,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMINOT2",307,0)
 ;
"RTN","SAMINOT2",308,0)
 quit $na(@root@("graph",sid,form,"notes",nien)) ; end of $$NTLOCN
"RTN","SAMINOT2",309,0)
 ;
"RTN","SAMINOT2",310,0)
 ;
"RTN","SAMINOT2",311,0)
 ;
"RTN","SAMINOT2",312,0)
NTLAST(sid,form,ntype) ; location of latest note of a type
"RTN","SAMINOT2",313,0)
 ;
"RTN","SAMINOT2",314,0)
 ;ven/gpl;private;function;
"RTN","SAMINOT2",315,0)
 ;@input
"RTN","SAMINOT2",316,0)
 ; ntype = type of note
"RTN","SAMINOT2",317,0)
 ;@output = global location of latest note of type ntype
"RTN","SAMINOT2",318,0)
 ;
"RTN","SAMINOT2",319,0)
 ; not yet written
"RTN","SAMINOT2",320,0)
 ;
"RTN","SAMINOT2",321,0)
 quit  ; end of $$NTLAST
"RTN","SAMINOT2",322,0)
 ;
"RTN","SAMINOT2",323,0)
 ;
"RTN","SAMINOT2",324,0)
 ;
"RTN","SAMINOT2",325,0)
NTLIST(nlist,sid,form) ; return note list
"RTN","SAMINOT2",326,0)
 ;
"RTN","SAMINOT2",327,0)
 ;ven/gpl;private;procedure;
"RTN","SAMINOT2",328,0)
 ;@output
"RTN","SAMINOT2",329,0)
 ; .nlist = note list [pass by reference]
"RTN","SAMINOT2",330,0)
 ;
"RTN","SAMINOT2",331,0)
 n zn,root,gn
"RTN","SAMINOT2",332,0)
 s root=$$setroot^%wd("vapals-patients")
"RTN","SAMINOT2",333,0)
 s zn=0
"RTN","SAMINOT2",334,0)
 s gn=$na(@root@("graph",sid,form,"notes"))
"RTN","SAMINOT2",335,0)
 q:'$d(@gn)
"RTN","SAMINOT2",336,0)
 f  s zn=$o(@gn@(zn)) q:+zn=0  d  ;
"RTN","SAMINOT2",337,0)
 . s @nlist@(zn,"name")=@gn@(zn,"name")
"RTN","SAMINOT2",338,0)
 . s @nlist@(zn,"nien")=zn
"RTN","SAMINOT2",339,0)
 ;
"RTN","SAMINOT2",340,0)
 quit  ; end of NTLIST
"RTN","SAMINOT2",341,0)
 ;
"RTN","SAMINOT2",342,0)
 ;
"RTN","SAMINOT2",343,0)
 ;
"RTN","SAMINOT2",344,0)
TLST ; test NTLIST
"RTN","SAMINOT2",345,0)
 ;
"RTN","SAMINOT2",346,0)
 ;ven/gpl;test;procedure;
"RTN","SAMINOT2",347,0)
 ;
"RTN","SAMINOT2",348,0)
 set SID="XXX00677"
"RTN","SAMINOT2",349,0)
 set FORM="siform-2019-04-23"
"RTN","SAMINOT2",350,0)
 do NTLIST("G",SID,FORM)
"RTN","SAMINOT2",351,0)
 ;
"RTN","SAMINOT2",352,0)
 ; zwrite G
"RTN","SAMINOT2",353,0)
 ;
"RTN","SAMINOT2",354,0)
 quit  ; end of TLST
"RTN","SAMINOT2",355,0)
 ;
"RTN","SAMINOT2",356,0)
 ;
"RTN","SAMINOT2",357,0)
 ;
"RTN","SAMINOT2",358,0)
VCNOTE(vals,dest,cnt) ; veteran communication note
"RTN","SAMINOT2",359,0)
 ;
"RTN","SAMINOT2",360,0)
 ;ven/gpl;private;procedure;
"RTN","SAMINOT2",361,0)
 ;
"RTN","SAMINOT2",362,0)
 ; do OUT("")
"RTN","SAMINOT2",363,0)
 ;
"RTN","SAMINOT2",364,0)
 d OUT("Veteran was contacted via:")
"RTN","SAMINOT2",365,0)
 n sp1 s sp1="    "
"RTN","SAMINOT2",366,0)
 d:$$XVAL("fucmotip",vals) OUT(sp1_"In person")
"RTN","SAMINOT2",367,0)
 d:$$XVAL("fucmotte",vals) OUT(sp1_"Telephone")
"RTN","SAMINOT2",368,0)
 d:$$XVAL("fucmotth",vals) OUT(sp1_"TeleHealth")
"RTN","SAMINOT2",369,0)
 d:$$XVAL("fucmotml",vals) OUT(sp1_"Mailed Letter")
"RTN","SAMINOT2",370,0)
 d:$$XVAL("fucmotpp",vals) OUT(sp1_"Message in patient portal")
"RTN","SAMINOT2",371,0)
 d:$$XVAL("fucmotvd",vals) OUT(sp1_"Video-on-demand (VOD)")
"RTN","SAMINOT2",372,0)
 d:$$XVAL("fucmotot",vals) OUT(sp1_"Other: "_$$XVAL("fucmotoo",vals))
"RTN","SAMINOT2",373,0)
 d OUT("")
"RTN","SAMINOT2",374,0)
 ;
"RTN","SAMINOT2",375,0)
 d:$$XVAL("fucmotde",vals)'=""
"RTN","SAMINOT2",376,0)
 . d OUT("Communication details:")
"RTN","SAMINOT2",377,0)
 . d OUT(sp1_$$XVAL("fucmotde",vals))
"RTN","SAMINOT2",378,0)
 ;
"RTN","SAMINOT2",379,0)
 d SSTATUS(vals) ; insert smoking status section
"RTN","SAMINOT2",380,0)
 ;
"RTN","SAMINOT2",381,0)
 quit  ; end of VCNOTE
"RTN","SAMINOT2",382,0)
 ;
"RTN","SAMINOT2",383,0)
 ;
"RTN","SAMINOT2",384,0)
 ;
"RTN","SAMINOT2",385,0)
SSTATUS(vals) ; smoking status
"RTN","SAMINOT2",386,0)
 ;
"RTN","SAMINOT2",387,0)
 ;ven/gpl;private;procedure;
"RTN","SAMINOT2",388,0)
 ;
"RTN","SAMINOT2",389,0)
 n sstat s sstat=""
"RTN","SAMINOT2",390,0)
 i $$XVAL("sisa",vals)="y" d  ; 
"RTN","SAMINOT2",391,0)
 . s sstat="Current"
"RTN","SAMINOT2",392,0)
 . d OUT("Smoking status: "_sstat)
"RTN","SAMINOT2",393,0)
 . d OUT(sp1_"Current cigarette smoker (patient advised that active tobacco use")
"RTN","SAMINOT2",394,0)
 . d OUT(sp1_"increases risk of future lung cancer, heart disease and stroke,")
"RTN","SAMINOT2",395,0)
 . d OUT(sp1_"advised stability now does not guarantee will not develop future")
"RTN","SAMINOT2",396,0)
 . d OUT(sp1_"lung cancer or risks of premature death from tobacco related heart")
"RTN","SAMINOT2",397,0)
 . d OUT(sp1_"disease and stroke)")
"RTN","SAMINOT2",398,0)
 i $$XVAL("sisa",vals)="n" d  ;
"RTN","SAMINOT2",399,0)
 . s sstat="Former"
"RTN","SAMINOT2",400,0)
 . d OUT("Smoking status: "_sstat)
"RTN","SAMINOT2",401,0)
 . n qdate s qdate=""
"RTN","SAMINOT2",402,0)
 . s qdate=$$XVAL("siq",vals)
"RTN","SAMINOT2",403,0)
 . i qdate'="" d OUT(sp1_"Former cigarette smoker. Quit date: "_qdate)
"RTN","SAMINOT2",404,0)
 . e  d OUT(sp1_"Former cigarette smoker.")
"RTN","SAMINOT2",405,0)
 i $$XVAL("sisa",vals)="o" d  ;
"RTN","SAMINOT2",406,0)
 . s sstat="Never"
"RTN","SAMINOT2",407,0)
 . d OUT("Smoking status: "_sstat)
"RTN","SAMINOT2",408,0)
 . d OUT(sp1_"Never cigarette smoker")
"RTN","SAMINOT2",409,0)
 ;
"RTN","SAMINOT2",410,0)
 n cumary
"RTN","SAMINOT2",411,0)
 d CUMPY^SAMIUR2("cumary",sid,form)
"RTN","SAMINOT2",412,0)
 k ^gpl("funote","cumary")
"RTN","SAMINOT2",413,0)
 m ^gpl("funote","cumary")=cumary
"RTN","SAMINOT2",414,0)
 n cur s cur=$g(cumary("current"))
"RTN","SAMINOT2",415,0)
 n newcum s newcum=$g(cumary("rpt",cur,4)) ; new cumulative pack years
"RTN","SAMINOT2",416,0)
 ;
"RTN","SAMINOT2",417,0)
 i $$XVAL("sisa",vals)="y" d  ;  
"RTN","SAMINOT2",418,0)
 . d OUT("Smoking history (since last visit):")
"RTN","SAMINOT2",419,0)
 . d OUT(sp1_"Cigarettes/day: "_$$XVAL("sicpd",vals))
"RTN","SAMINOT2",420,0)
 . d OUT(sp1_"PPD: "_$$XVAL("sippd",vals))
"RTN","SAMINOT2",421,0)
 . d OUT(sp1_"Current cumulative pack years: "_newcum)
"RTN","SAMINOT2",422,0)
 i $$XVAL("sisa",vals)'="y" d  ;  
"RTN","SAMINOT2",423,0)
 . d OUT("Smoking History")
"RTN","SAMINOT2",424,0)
 n zi
"RTN","SAMINOT2",425,0)
 f zi=1:1:cur d  ;
"RTN","SAMINOT2",426,0)
 . d OUT(sp1_cumary("rpt",zi,1)_" "_cumary("rpt",zi,2))
"RTN","SAMINOT2",427,0)
 . d OUT(sp1_sp1_"Pack Years: "_cumary("rpt",zi,3))
"RTN","SAMINOT2",428,0)
 . d OUT(sp1_sp1_"Cumulative: "_cumary("rpt",zi,4))
"RTN","SAMINOT2",429,0)
 ;
"RTN","SAMINOT2",430,0)
 n tried s tried=$$XVAL("sittq",vals)
"RTN","SAMINOT2",431,0)
 n ptried s ptried=$s(tried="y":"Yes",tried="n":"No",tried="o":"Not applicable",1:"")
"RTN","SAMINOT2",432,0)
 i ptried'="" d OUT("Since your prior CT scan have you ever tried to quit smoking? "_ptried)
"RTN","SAMINOT2",433,0)
 ;
"RTN","SAMINOT2",434,0)
 n tryary,cnt
"RTN","SAMINOT2",435,0)
 s cnt=0
"RTN","SAMINOT2",436,0)
 i $$XVAL("sisca",vals)'="" s cnt=cnt+1 s tryary(cnt)="Have not tried to quit"
"RTN","SAMINOT2",437,0)
 i $$XVAL("siscb",vals)'="" s cnt=cnt+1 s tryary(cnt)="""Cold Turkey"" by completely stopping on your own with no other assistance"
"RTN","SAMINOT2",438,0)
 i $$XVAL("siscc",vals)'="" s cnt=cnt+1 s tryary(cnt)="Tapering or reducing number of cigarettes smoked per day"
"RTN","SAMINOT2",439,0)
 i $$XVAL("siscd",vals)'="" s cnt=cnt+1 s tryary(cnt)="Self-help material (e.g., brochure, cessation website)"
"RTN","SAMINOT2",440,0)
 i $$XVAL("sisce",vals)'="" s cnt=cnt+1 s tryary(cnt)="Individual consultation or cessation counseling"
"RTN","SAMINOT2",441,0)
 i $$XVAL("siscf",vals)'="" s cnt=cnt+1 s tryary(cnt)="Telephone cessation counseling hotline (e.g., 1-855-QUIT-VET, 1-800-QUIT-NOW)"
"RTN","SAMINOT2",442,0)
 i $$XVAL("siscg",vals)'="" s cnt=cnt+1 s tryary(cnt)="Peer support (e.g., Nicotine Anonymous)"
"RTN","SAMINOT2",443,0)
 i $$XVAL("sisch",vals)'="" s cnt=cnt+1 s tryary(cnt)="Nicotine replacement therapy (e.g., patch, gum, inhaler, nasal spray, lozenge)"
"RTN","SAMINOT2",444,0)
 i $$XVAL("sisci",vals)'="" s cnt=cnt+1 s tryary(cnt)="Zyban"
"RTN","SAMINOT2",445,0)
 i $$XVAL("siscj",vals)'="" s cnt=cnt+1 s tryary(cnt)="Hypnosis"
"RTN","SAMINOT2",446,0)
 i $$XVAL("sisck",vals)'="" s cnt=cnt+1 s tryary(cnt)="Acupuncture / acupressure"
"RTN","SAMINOT2",447,0)
 n tryot s tryot=""
"RTN","SAMINOT2",448,0)
 i $$XVAL("siscl",vals)'="" d  ;
"RTN","SAMINOT2",449,0)
 . s cnt=cnt+1 s tryary(cnt)="Other (specify)"
"RTN","SAMINOT2",450,0)
 . s tryot=$$XVAL("siscos",vals)
"RTN","SAMINOT2",451,0)
 ;
"RTN","SAMINOT2",452,0)
 i cnt>0 d  ;
"RTN","SAMINOT2",453,0)
 .  i ptried="" d OUT("Since your prior CT scan have you ever tried to quit smoking? ")
"RTN","SAMINOT2",454,0)
 . n zi s zi=""
"RTN","SAMINOT2",455,0)
 . f  s zi=$o(tryary(zi)) q:zi=""  d  ;
"RTN","SAMINOT2",456,0)
 . . d OUT(sp1_tryary(zi))
"RTN","SAMINOT2",457,0)
 . i tryot'="" d OUT(sp1_sp1_tryot)
"RTN","SAMINOT2",458,0)
 ;
"RTN","SAMINOT2",459,0)
 n cess,cess2 s cess="" s cess2=""
"RTN","SAMINOT2",460,0)
 i $$XVAL("siscmd",vals)="d" s cess="Declined"
"RTN","SAMINOT2",461,0)
 i $$XVAL("siscmd",vals)="a" s cess="Advised to quit smoking; VA resources provided"
"RTN","SAMINOT2",462,0)
 i $$XVAL("siscmd",vals)="i" d  ;
"RTN","SAMINOT2",463,0)
 . s cess="Interested in VA tobacco cessation medication. Encouraged Veteran"
"RTN","SAMINOT2",464,0)
 . s cess2="to talk to provider or pharmacist about which medication option is best for you."
"RTN","SAMINOT2",465,0)
 i cess'="" d  ;
"RTN","SAMINOT2",466,0)
 . d OUT("Tobacco cessation provided:")
"RTN","SAMINOT2",467,0)
 . d OUT(sp1_cess)
"RTN","SAMINOT2",468,0)
 . i cess2'="" d OUT(sp1_cess2)
"RTN","SAMINOT2",469,0)
 ;
"RTN","SAMINOT2",470,0)
 quit  ; end of SSTATUS
"RTN","SAMINOT2",471,0)
 ;
"RTN","SAMINOT2",472,0)
 ;
"RTN","SAMINOT2",473,0)
 ;
"RTN","SAMINOT2",474,0)
LCSNOTE(vals,dest,cnt) ; lung cancer screening note
"RTN","SAMINOT2",475,0)
 ;
"RTN","SAMINOT2",476,0)
 ;ven/gpl;private;procedure;
"RTN","SAMINOT2",477,0)
 ;
"RTN","SAMINOT2",478,0)
 ; do OUT("")
"RTN","SAMINOT2",479,0)
 ;
"RTN","SAMINOT2",480,0)
 n sp1 s sp1="    "
"RTN","SAMINOT2",481,0)
 d OUT("Initial LDCT/Baseline: "_$$XVAL("sidoe",vals))
"RTN","SAMINOT2",482,0)
 d OUT("Date of most recent CT/LDCT: "_$$XVAL("fulctdt",vals))
"RTN","SAMINOT2",483,0)
 d OUT(sp1_"Notification of Results: "_$$XVAL("sidof",vals))
"RTN","SAMINOT2",484,0)
 n addcmt s addcmt=$$XVAL("fucmctde",vals)
"RTN","SAMINOT2",485,0)
 i addcmt'="" d  ;
"RTN","SAMINOT2",486,0)
 . d OUT("Additional comments:")
"RTN","SAMINOT2",487,0)
 . d OUT(sp1_addcmt)
"RTN","SAMINOT2",488,0)
 n impress s impress=""
"RTN","SAMINOT2",489,0)
 n ctary
"RTN","SAMINOT2",490,0)
 d CTINFO("ctary",sid,form)
"RTN","SAMINOT2",491,0)
 s impress=$g(ctary("impression"))
"RTN","SAMINOT2",492,0)
 ; get impression from lastest CT Eval here
"RTN","SAMINOT2",493,0)
 d IMPRESS("ctary",sid)
"RTN","SAMINOT2",494,0)
 ;i impress'="" d  ;
"RTN","SAMINOT2",495,0)
 ;. d OUT("Impression:")
"RTN","SAMINOT2",496,0)
 ;. d OUT(sp1_impress)
"RTN","SAMINOT2",497,0)
 ; smoking status follows
"RTN","SAMINOT2",498,0)
 d SSTATUS(vals)
"RTN","SAMINOT2",499,0)
 ;d OUT("Veteran was contacted via:")
"RTN","SAMINOT2",500,0)
 ;n sp1 s sp1="    "
"RTN","SAMINOT2",501,0)
 ;d:$$XVAL("fucmctip",vals) OUT(sp1_"In person")
"RTN","SAMINOT2",502,0)
 ;d:$$XVAL("fucmctte",vals) OUT(sp1_"Telephone")
"RTN","SAMINOT2",503,0)
 ;d:$$XVAL("fucmctth",vals) OUT(sp1_"TeleHealth")
"RTN","SAMINOT2",504,0)
 ;d:$$XVAL("fucmctml",vals) OUT(sp1_"Mailed Letter")
"RTN","SAMINOT2",505,0)
 ;d:$$XVAL("fucmctpp",vals) OUT(sp1_"Message in patient portal")
"RTN","SAMINOT2",506,0)
 ;d:$$XVAL("fucmctvd",vals) OUT(sp1_"Video-on-demand (VOD)")
"RTN","SAMINOT2",507,0)
 ;d:$$XVAL("fucmctot",vals) OUT(sp1_"Other: "_$$XVAL("fucmctoo",vals))
"RTN","SAMINOT2",508,0)
 ;d OUT("")
"RTN","SAMINOT2",509,0)
 ;
"RTN","SAMINOT2",510,0)
 ;d:$$XVAL("fucmctde",vals)'=""
"RTN","SAMINOT2",511,0)
 ;. d OUT("Communication details:")
"RTN","SAMINOT2",512,0)
 ;. d OUT(sp1_$$XVAL("fucmctde",vals))
"RTN","SAMINOT2",513,0)
 n recom s recom=""
"RTN","SAMINOT2",514,0)
 ; get recommendations from CT eval form here
"RTN","SAMINOT2",515,0)
 s recom=$g(ctary("followup"))
"RTN","SAMINOT2",516,0)
 i recom'="" d  ;
"RTN","SAMINOT2",517,0)
 . d OUT("Recommendations:")
"RTN","SAMINOT2",518,0)
 . d OUT(sp1_recom)
"RTN","SAMINOT2",519,0)
 . i $g(ctary("followup2"))'="" d  ;
"RTN","SAMINOT2",520,0)
 . . d OUT(sp1_ctary("followup2"))
"RTN","SAMINOT2",521,0)
 . i $g(ctary("followup3"))'="" d  ;
"RTN","SAMINOT2",522,0)
 . . d OUT(sp1_ctary("followup3"))
"RTN","SAMINOT2",523,0)
 n ordered s ordered=$$XVAL("funewct",vals)
"RTN","SAMINOT2",524,0)
 i ordered'="" d  ;
"RTN","SAMINOT2",525,0)
 . s ordered=$s(ordered="y":"Yes",ordered="n":"No",1:"")
"RTN","SAMINOT2",526,0)
 . d OUT("CT/LDCT ordered: "_ordered)
"RTN","SAMINOT2",527,0)
 n pulmon s pulmon=$$XVAL("fucompul",vals)
"RTN","SAMINOT2",528,0)
 i pulmon'="" d  ;
"RTN","SAMINOT2",529,0)
 . s pulmon=$s(pulmon="y":"Yes",pulmon="n":"No",1:"")
"RTN","SAMINOT2",530,0)
 . d OUT("Communicated to Pulmonary: "_pulmon)
"RTN","SAMINOT2",531,0)
 ;
"RTN","SAMINOT2",532,0)
 quit  ; end of LCSNOTE
"RTN","SAMINOT2",533,0)
 ;
"RTN","SAMINOT2",534,0)
 ;
"RTN","SAMINOT2",535,0)
 ;
"RTN","SAMINOT2",536,0)
OUT(ln) ; output new line to note
"RTN","SAMINOT2",537,0)
 ;
"RTN","SAMINOT2",538,0)
 ;ven/gpl;private;procedure;
"RTN","SAMINOT2",539,0)
 ;
"RTN","SAMINOT2",540,0)
 s cnt=cnt+1
"RTN","SAMINOT2",541,0)
 n lnn
"RTN","SAMINOT2",542,0)
 ;s debug=1
"RTN","SAMINOT2",543,0)
 s lnn=$o(@dest@(" "),-1)+1
"RTN","SAMINOT2",544,0)
 s @dest@(lnn)=ln
"RTN","SAMINOT2",545,0)
 ;
"RTN","SAMINOT2",546,0)
 ;i $g(debug)=1 d  ;
"RTN","SAMINOT2",547,0)
 ;. i ln["<" q  ; no markup
"RTN","SAMINOT2",548,0)
 ;. n zs s zs=$STACK
"RTN","SAMINOT2",549,0)
 ;. n zp s zp=$STACK(zs-2,"PLACE")
"RTN","SAMINOT2",550,0)
 ;. s @dest@(lnn)=zp_":"_ln
"RTN","SAMINOT2",551,0)
 ;
"RTN","SAMINOT2",552,0)
 quit  ; end of OUT
"RTN","SAMINOT2",553,0)
 ;
"RTN","SAMINOT2",554,0)
 ;
"RTN","SAMINOT2",555,0)
 ;
"RTN","SAMINOT2",556,0)
XVAL(var,vals) ; value of form variable
"RTN","SAMINOT2",557,0)
 ;
"RTN","SAMINOT2",558,0)
 ;ven/gpl;private;function;
"RTN","SAMINOT2",559,0)
 ;@input
"RTN","SAMINOT2",560,0)
 ; var = name of form variable
"RTN","SAMINOT2",561,0)
 ; vals = global root of form variable array
"RTN","SAMINOT2",562,0)
 ; @vals = form variable array [pass by name]
"RTN","SAMINOT2",563,0)
 ;@output = value of form variable
"RTN","SAMINOT2",564,0)
 ;
"RTN","SAMINOT2",565,0)
 new zr
"RTN","SAMINOT2",566,0)
 set zr=$get(@vals@(var))
"RTN","SAMINOT2",567,0)
 ;
"RTN","SAMINOT2",568,0)
 ; i zr="" s zr="["_var_"]"
"RTN","SAMINOT2",569,0)
 ;
"RTN","SAMINOT2",570,0)
 quit zr ; end of $$XVAL
"RTN","SAMINOT2",571,0)
 ;
"RTN","SAMINOT2",572,0)
 ;
"RTN","SAMINOT2",573,0)
 ;
"RTN","SAMINOT2",574,0)
PREVCT(SID,FORM) ; key to previous ct eval form
"RTN","SAMINOT2",575,0)
 ;
"RTN","SAMINOT2",576,0)
 ;ven/gpl;private;function;
"RTN","SAMINOT2",577,0)
 ;@input
"RTN","SAMINOT2",578,0)
 ; FORM = [not yet implemented, always treated as if FORM=""]
"RTN","SAMINOT2",579,0)
 ;@output = form key of CT Eval form previous to FORM
"RTN","SAMINOT2",580,0)
 ;
"RTN","SAMINOT2",581,0)
 ; $$PREVCT returns the form key to the CT Eval form previous to
"RTN","SAMINOT2",582,0)
 ; FORM. If FORM is null, the latest CT Eval form key is returned.
"RTN","SAMINOT2",583,0)
 ;
"RTN","SAMINOT2",584,0)
 new gn set gn=$$setroot^%wd("vapals-patients")
"RTN","SAMINOT2",585,0)
 new prev set prev=$order(@gn@("graph",SID,"ceform-30"),-1)
"RTN","SAMINOT2",586,0)
 ;
"RTN","SAMINOT2",587,0)
 quit prev ; end of $$PREVCT
"RTN","SAMINOT2",588,0)
 ;
"RTN","SAMINOT2",589,0)
 ;
"RTN","SAMINOT2",590,0)
 ;
"RTN","SAMINOT2",591,0)
CTINFO(ARY,SID,FORM) ; extracts from latest CT Eval form
"RTN","SAMINOT2",592,0)
 ;
"RTN","SAMINOT2",593,0)
 ;ven/gpl;private;procedure;
"RTN","SAMINOT2",594,0)
 ;@input
"RTN","SAMINOT2",595,0)
 ; ARY = name of output array
"RTN","SAMINOT2",596,0)
 ; SID
"RTN","SAMINOT2",597,0)
 ; FORM
"RTN","SAMINOT2",598,0)
 ;@output
"RTN","SAMINOT2",599,0)
 ; @ARY = extract from latest ct eval form [passed by name]
"RTN","SAMINOT2",600,0)
 ;
"RTN","SAMINOT2",601,0)
 n ctkey s ctkey=$$PREVCT(SID,$G(FORM))
"RTN","SAMINOT2",602,0)
 q:ctkey=""
"RTN","SAMINOT2",603,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMINOT2",604,0)
 n ctroot s ctroot=$na(@root@("graph",SID,ctkey))
"RTN","SAMINOT2",605,0)
 ;
"RTN","SAMINOT2",606,0)
 s @ARY@("ctform")=ctkey
"RTN","SAMINOT2",607,0)
 s @ARY@("impression")=$g(@ctroot@("ceimre"))
"RTN","SAMINOT2",608,0)
 n futext
"RTN","SAMINOT2",609,0)
 s futext=$g(@ctroot@("cefuw"))
"RTN","SAMINOT2",610,0)
 n futbl
"RTN","SAMINOT2",611,0)
 s futbl("1y")="Annual repeat"
"RTN","SAMINOT2",612,0)
 s futbl("nw")="Now"
"RTN","SAMINOT2",613,0)
 s futbl("1m")="1 month"
"RTN","SAMINOT2",614,0)
 s futbl("3m")="3 months"
"RTN","SAMINOT2",615,0)
 s futbl("6m")="6 months"
"RTN","SAMINOT2",616,0)
 s futbl("os")="other"
"RTN","SAMINOT2",617,0)
 i futext'="" s futext=$g(futbl(futext))
"RTN","SAMINOT2",618,0)
 n fudate s fudate=$g(@ctroot@("cefud"))
"RTN","SAMINOT2",619,0)
 ; #Other followup
"RTN","SAMINOT2",620,0)
 n zfu,ofu,tofu,comma
"RTN","SAMINOT2",621,0)
 n vals s vals=ctroot
"RTN","SAMINOT2",622,0)
 s comma=0,tofu=""
"RTN","SAMINOT2",623,0)
 s ofu=""
"RTN","SAMINOT2",624,0)
 f zfu="cefuaf","cefucc","cefupe","cefufn","cefubr","cefupc","cefutb" d  ;
"RTN","SAMINOT2",625,0)
 . i $$XVAL(zfu,vals)="y" s ofu=ofu_zfu
"RTN","SAMINOT2",626,0)
 i $$XVAL("cefuo",vals)'="" s ofu=ofu_"cefuo"
"RTN","SAMINOT2",627,0)
 i ofu'="" d  ;
"RTN","SAMINOT2",628,0)
 . s tofu="Other followup: "
"RTN","SAMINOT2",629,0)
 . i ofu["cefuaf" s tofu=tofu_"Antibiotics" s comma=1
"RTN","SAMINOT2",630,0)
 . i ofu["cefucc" s tofu=tofu_$s(comma:", ",1:"")_"Diagnostic CT" s comma=1
"RTN","SAMINOT2",631,0)
 . i ofu["cefupe" s tofu=tofu_$s(comma:", ",1:"")_"PET" s comma=1
"RTN","SAMINOT2",632,0)
 . i ofu["cefufn" s tofu=tofu_$s(comma:", ",1:"")_"Percutaneous biopsy" s comma=1
"RTN","SAMINOT2",633,0)
 . i ofu["cefubr" s tofu=tofu_$s(comma:", ",1:"")_"Bronchoscopy" s comma=1
"RTN","SAMINOT2",634,0)
 . i ofu["cefupc" s tofu=tofu_$s(comma:", ",1:"")_"Pulmonary consultation" s comma=1
"RTN","SAMINOT2",635,0)
 . i ofu["cefutb" s tofu=tofu_$s(comma:", ",1:"")_"Refer to tumor board" s comma=1
"RTN","SAMINOT2",636,0)
 . i ofu["cefuo" s tofu=tofu_$s(comma:", ",1:"")_"Other:" s comma=1
"RTN","SAMINOT2",637,0)
 s @ARY@("followup")=futext_" "_fudate
"RTN","SAMINOT2",638,0)
 s @ARY@("followup2")=tofu
"RTN","SAMINOT2",639,0)
 s @ARY@("followup3")=$$XVAL("cefuoo",vals)
"RTN","SAMINOT2",640,0)
 ;
"RTN","SAMINOT2",641,0)
 quit  ; end of CTINFO
"RTN","SAMINOT2",642,0)
 ;
"RTN","SAMINOT2",643,0)
 ;
"RTN","SAMINOT2",644,0)
 ; 
"RTN","SAMINOT2",645,0)
IMPRESS(ARY,SID) ; impressions from ct eval report
"RTN","SAMINOT2",646,0)
 ;
"RTN","SAMINOT2",647,0)
 ;ven/gpl;private;procedure;
"RTN","SAMINOT2",648,0)
 ;@input
"RTN","SAMINOT2",649,0)
 ; ARY = name of output array
"RTN","SAMINOT2",650,0)
 ; SID
"RTN","SAMINOT2",651,0)
 ;@output
"RTN","SAMINOT2",652,0)
 ; @ARY = impressions from ct eval report [passed by name]
"RTN","SAMINOT2",653,0)
 ;
"RTN","SAMINOT2",654,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMINOT2",655,0)
 n ctkey s ctkey=$g(@ARY@("ctform"))
"RTN","SAMINOT2",656,0)
 n vals s vals=$na(@root@("graph",SID,ctkey))
"RTN","SAMINOT2",657,0)
 n dict s dict=$$setroot^%wd("cteval-dict")
"RTN","SAMINOT2",658,0)
 s dict=$na(@dict@("cteval-dict"))
"RTN","SAMINOT2",659,0)
 n para s para=""
"RTN","SAMINOT2",660,0)
 n sp1 s sp1="    "
"RTN","SAMINOT2",661,0)
 ; 
"RTN","SAMINOT2",662,0)
 d OUT("Impression:")
"RTN","SAMINOT2",663,0)
 d OUT(sp1_$$XSUB("ceimn",vals,dict)_para)
"RTN","SAMINOT2",664,0)
 ;
"RTN","SAMINOT2",665,0)
 ;# Report CAC Score and Extent of Emphysema
"RTN","SAMINOT2",666,0)
 s cacval=0
"RTN","SAMINOT2",667,0)
 d  ;if $$XVAL("ceccv",vals)'="e" d  ;
"RTN","SAMINOT2",668,0)
 . set vcac=$$XVAL("cecccac",vals)
"RTN","SAMINOT2",669,0)
 . if vcac'="" d  ;
"RTN","SAMINOT2",670,0)
 . . s cacrec=""
"RTN","SAMINOT2",671,0)
 . . s cac="The Visual Coronary Artery Calcium (CAC) Score is "_vcac_". "
"RTN","SAMINOT2",672,0)
 . . s cacval=vcac
"RTN","SAMINOT2",673,0)
 . . i cacval>3 s cacrec=$g(@dict@("CAC_recommendation"))_para
"RTN","SAMINOT2",674,0)
 ;
"RTN","SAMINOT2",675,0)
 i cacval>0 d  ;
"RTN","SAMINOT2",676,0)
 . d OUT(sp1_cac_" "_cacrec_" "_para)
"RTN","SAMINOT2",677,0)
 . d  ;if $$XVAL("ceemv",vals)="e" d  ;
"RTN","SAMINOT2",678,0)
 . . if $$XVAL("ceem",vals)'="no" d  ;
"RTN","SAMINOT2",679,0)
 . . . if $$XVAL("ceem",vals)="nv" q  ;
"RTN","SAMINOT2",680,0)
 . . . d OUT(sp1_"Emphysema: "_$$XSUB("ceem",vals,dict)_"."_para)
"RTN","SAMINOT2",681,0)
 ;
"RTN","SAMINOT2",682,0)
 i $$XVAL("ceclini",vals)="y" d  ;
"RTN","SAMINOT2",683,0)
 . d OUT(sp1_$$XVAL("ceclin",vals)_"."_para)
"RTN","SAMINOT2",684,0)
 ;
"RTN","SAMINOT2",685,0)
 i $$XVAL("ceoppai",vals)="y" d  ;
"RTN","SAMINOT2",686,0)
 . d OUT(sp1_$$XVAL("ceoppa",vals)_"."_para)
"RTN","SAMINOT2",687,0)
 ;
"RTN","SAMINOT2",688,0)
 i $$XVAL("ceoppabi",vals)="y" d  ;
"RTN","SAMINOT2",689,0)
 . d OUT(sp1_$$XVAL("ceoppab",vals)_"."_para)
"RTN","SAMINOT2",690,0)
 ;
"RTN","SAMINOT2",691,0)
 i $$XVAL("cecommcai",vals)="y" d  ;
"RTN","SAMINOT2",692,0)
 . d OUT(sp1_$$XVAL("cecommca",vals)_"."_para)
"RTN","SAMINOT2",693,0)
 ;
"RTN","SAMINOT2",694,0)
 i $$XVAL("ceotabnmi",vals)="y" d  ;
"RTN","SAMINOT2",695,0)
 . d OUT(sp1_$$XVAL("ceotabnm",vals)_"."_para)
"RTN","SAMINOT2",696,0)
 ;
"RTN","SAMINOT2",697,0)
 i $$XVAL("ceobrci",vals)="y" d  ;
"RTN","SAMINOT2",698,0)
 . d OUT(sp1_$$XVAL("ceobrc",vals)_"."_para)
"RTN","SAMINOT2",699,0)
 ;
"RTN","SAMINOT2",700,0)
 i $$XVAL("ceaoabbi",vals)="y" d  ;
"RTN","SAMINOT2",701,0)
 . d OUT(sp1_$$XVAL("ceaoabb",vals)_"."_para)
"RTN","SAMINOT2",702,0)
 ;
"RTN","SAMINOT2",703,0)
 i $$XVAL("ceaoabi",vals)="y" d  ;
"RTN","SAMINOT2",704,0)
 . d OUT(sp1_$$XVAL("ceaoab",vals)_"."_para)
"RTN","SAMINOT2",705,0)
 ;
"RTN","SAMINOT2",706,0)
 ;# Impression Remarks
"RTN","SAMINOT2",707,0)
 i $$XVAL("ceimre",vals)'="" d  ;
"RTN","SAMINOT2",708,0)
 . d OUT(sp1_$$XVAL("ceimre",vals)_"."_para)
"RTN","SAMINOT2",709,0)
 ;
"RTN","SAMINOT2",710,0)
 quit  ; end of IMPRESS
"RTN","SAMINOT2",711,0)
 ;
"RTN","SAMINOT2",712,0)
 ;
"RTN","SAMINOT2",713,0)
 ;
"RTN","SAMINOT2",714,0)
XSUB(var,vals,dict,valdx) ; dictionary value for variable
"RTN","SAMINOT2",715,0)
 ;
"RTN","SAMINOT2",716,0)
 ;ven/gpl;private;function;
"RTN","SAMINOT2",717,0)
 ;@input
"RTN","SAMINOT2",718,0)
 ; var = name of dictionary value
"RTN","SAMINOT2",719,0)
 ; vals = name of variables array
"RTN","SAMINOT2",720,0)
 ; @vals = variables array [passed by name]
"RTN","SAMINOT2",721,0)
 ; dict = name of dictionary array
"RTN","SAMINOT2",722,0)
 ; @dict = dictionary array [passed by name]
"RTN","SAMINOT2",723,0)
 ; valdx = used for nodules ala cect2co with nodule # included
"RTN","SAMINOT2",724,0)
 ;@output = dictionary value for variable
"RTN","SAMINOT2",725,0)
 ;
"RTN","SAMINOT2",726,0)
 ; new dict set dict=$$setroot^%wd("cteval-dict")
"RTN","SAMINOT2",727,0)
 ;
"RTN","SAMINOT2",728,0)
 n zr,zv,zdx
"RTN","SAMINOT2",729,0)
 s zdx=$g(valdx)
"RTN","SAMINOT2",730,0)
 i zdx="" s zdx=var
"RTN","SAMINOT2",731,0)
 s zv=$g(@vals@(zdx))
"RTN","SAMINOT2",732,0)
 ;i zv="" s zr="["_var_"]" q zr
"RTN","SAMINOT2",733,0)
 i zv="" s zr="" q zr
"RTN","SAMINOT2",734,0)
 s zr=$g(@dict@(var,zv))
"RTN","SAMINOT2",735,0)
 ;i zr="" s zr="["_var_","_zv_"]"
"RTN","SAMINOT2",736,0)
 ;
"RTN","SAMINOT2",737,0)
 quit zr ; end of $$XSUB
"RTN","SAMINOT2",738,0)
 ;
"RTN","SAMINOT2",739,0)
 ;
"RTN","SAMINOT2",740,0)
 ;
"RTN","SAMINOT2",741,0)
EOR ; end of routine SAMINOT2
"RTN","SAMINUL")
0^7^B82731
"RTN","SAMINUL",1,0)
SAMINUL ;ven/gpl - ielcap: note log ;2021-03-17T18:38Z
"RTN","SAMINUL",2,0)
 ;;18.0;SAMI;**9**;;Build 5
"RTN","SAMINUL",3,0)
 ;;1.18.0.9-i9
"RTN","SAMINUL",4,0)
 ;
"RTN","SAMINUL",5,0)
 ; SAMINOTE contains subroutines for producing the ELCAP Note Pages.
"RTN","SAMINUL",6,0)
 ; SAMINUL contains the development log for the SAMINOT* routines.
"RTN","SAMINUL",7,0)
 ; It contains no executable code.
"RTN","SAMINUL",8,0)
 ;
"RTN","SAMINUL",9,0)
 quit  ; no entry from top
"RTN","SAMINUL",10,0)
 ;
"RTN","SAMINUL",11,0)
 ;
"RTN","SAMINUL",12,0)
 ;
"RTN","SAMINUL",13,0)
 ;@section 0 primary development
"RTN","SAMINUL",14,0)
 ;
"RTN","SAMINUL",15,0)
 ;
"RTN","SAMINUL",16,0)
 ;
"RTN","SAMINUL",17,0)
 ;@routine-credits
"RTN","SAMINUL",18,0)
 ;@primary-dev George P. Lilly (gpl)
"RTN","SAMINUL",19,0)
 ; gpl@vistaexpertise.net
"RTN","SAMINUL",20,0)
 ;@primary-dev-org Vista Expertise Network (ven)
"RTN","SAMINUL",21,0)
 ; http://vistaexpertise.net
"RTN","SAMINUL",22,0)
 ;@copyright 2017/2021, gpl, all rights reserved
"RTN","SAMINUL",23,0)
 ;@license see routine SAMIUL
"RTN","SAMINUL",24,0)
 ;
"RTN","SAMINUL",25,0)
 ;@last-updated 2021-03-17T18:38Z
"RTN","SAMINUL",26,0)
 ;@application Screening Applications Management (SAM)
"RTN","SAMINUL",27,0)
 ;@module Screening Applications Management - IELCAP (SAMI)
"RTN","SAMINUL",28,0)
 ;@suite-of-files SAMI Forms (311.101-311.199)
"RTN","SAMINUL",29,0)
 ;@version 1.18.0.9-i9
"RTN","SAMINUL",30,0)
 ;@release-date 2020-01
"RTN","SAMINUL",31,0)
 ;@patch-list **9**
"RTN","SAMINUL",32,0)
 ;
"RTN","SAMINUL",33,0)
 ;@additional-dev Frederick D. S. Marshall (toad)
"RTN","SAMINUL",34,0)
 ; toad@vistaexpertise.net
"RTN","SAMINUL",35,0)
 ;@additional-dev Larry G. Carlson (lgc)
"RTN","SAMINUL",36,0)
 ; larry.g.carlson@gmail.com
"RTN","SAMINUL",37,0)
 ;@additional-dev Alexis R. Carlson (arc)
"RTN","SAMINUL",38,0)
 ; whatisthehumanspirit@gmail.com
"RTN","SAMINUL",39,0)
 ;
"RTN","SAMINUL",40,0)
 ;@module-credits
"RTN","SAMINUL",41,0)
 ;@project VA Partnership to Increase Access to Lung Screening
"RTN","SAMINUL",42,0)
 ; (VA-PALS)
"RTN","SAMINUL",43,0)
 ; http://va-pals.org/
"RTN","SAMINUL",44,0)
 ;@funding 2017/2021, Bristol-Myers Squibb Foundation (bmsf)
"RTN","SAMINUL",45,0)
 ; https://www.bms.com/about-us/responsibility/bristol-myers-squibb-foundation.html
"RTN","SAMINUL",46,0)
 ;@partner-org Veterans Affairs Office of Rural health
"RTN","SAMINUL",47,0)
 ; https://www.ruralhealth.va.gov/
"RTN","SAMINUL",48,0)
 ;@partner-org International Early Lung Cancer Action Program (I-ELCAP)
"RTN","SAMINUL",49,0)
 ; http://ielcap.com/
"RTN","SAMINUL",50,0)
 ;@partner-org Paraxial Technologies (par)
"RTN","SAMINUL",51,0)
 ; http://paraxialtech.com/
"RTN","SAMINUL",52,0)
 ;@partner-org Open Source Electronic Health Record Alliance (OSEHRA)
"RTN","SAMINUL",53,0)
 ; https://www.osehra.org/groups/va-pals-open-source-project-group
"RTN","SAMINUL",54,0)
 ;
"RTN","SAMINUL",55,0)
 ;@module-log repo github.com:VA-PALS-ELCAP/SAMI-VAPALS-ELCAP.git
"RTN","SAMINUL",56,0)
 ;
"RTN","SAMINUL",57,0)
 ; 2020-01-17/20 ven/lgc 1.18.0.1-i1 8557207f,d7d24834,0301ad95.
"RTN","SAMINUL",58,0)
 ;  659f2526,0ff2b83f,49615242,5bf7c398,dc5f618c
"RTN","SAMINUL",59,0)
 ;  SAMINOT2: followup note, fixed typos in VC note, followup LCS note
"RTN","SAMINUL",60,0)
 ; minus CT Eval pulls, LCS note with CT Eval extracts, fixed bug in
"RTN","SAMINUL",61,0)
 ; LSC CT eval extract, include entire impression section of CT Eval
"RTN","SAMINUL",62,0)
 ; report in LCS Note, improved import of impressions, limit to one
"RTN","SAMINUL",63,0)
 ; note per followup form.
"RTN","SAMINUL",64,0)
 ;
"RTN","SAMINUL",65,0)
 ; 2021-03-02 ven/gpl 1.18.0.9-i9 479dc041
"RTN","SAMINUL",66,0)
 ;  SAMINOT2: return error message if no ct eval form exists when
"RTN","SAMINUL",67,0)
 ; generating a fu note.
"RTN","SAMINUL",68,0)
 ;
"RTN","SAMINUL",69,0)
 ; 2021-03-15 ven/toad 1.18.0.9-i9
"RTN","SAMINUL",70,0)
 ;  SAMINUL: create routine.
"RTN","SAMINUL",71,0)
 ;  SAMINOT2: bump date & patch list, add contents, lt refactor.
"RTN","SAMINUL",72,0)
 ;
"RTN","SAMINUL",73,0)
 ; 2021-03-17 ven/toad 1.18.0.9-i9
"RTN","SAMINUL",74,0)
 ; SAMINOT2: remove blank from end of 1 line.
"RTN","SAMINUL",75,0)
 ;
"RTN","SAMINUL",76,0)
 ;
"RTN","SAMINUL",77,0)
 ;
"RTN","SAMINUL",78,0)
EOR ; end of routine SAMINUL
"RTN","SAMIUL")
0^8^B17740
"RTN","SAMIUL",1,0)
SAMIUL ;ven/staff - vapals-elcap license ;2021-03-17T18:40Z
"RTN","SAMIUL",2,0)
 ;;18.0;SAMI;**9**;;Build 5
"RTN","SAMIUL",3,0)
 ;;1.18.0.9-i9
"RTN","SAMIUL",4,0)
 ;
"RTN","SAMIUL",5,0)
 ; Copyright 2019 Early Diagnosis & Treatment Research Foundation,
"RTN","SAMIUL",6,0)
 ; Vista Expertise Network (VEN), & Paraxial
"RTN","SAMIUL",7,0)
 ;
"RTN","SAMIUL",8,0)
 ; The original management system was created & donated by Early
"RTN","SAMIUL",9,0)
 ; Diagnosis & Treatment Research Foundation within the International
"RTN","SAMIUL",10,0)
 ; Early Lung Cancer Action Program (I-ELCAP), an international
"RTN","SAMIUL",11,0)
 ; program of lung cancer screening.
"RTN","SAMIUL",12,0)
 ;
"RTN","SAMIUL",13,0)
 ; Licensed under the Apache License, Version 2.0 (the "License"); you
"RTN","SAMIUL",14,0)
 ; may not use this file except in compliance with the License. You
"RTN","SAMIUL",15,0)
 ; may obtain a copy of the License at:
"RTN","SAMIUL",16,0)
 ; http://www.apache.org/licenses/LICENSE-2.0
"RTN","SAMIUL",17,0)
 ;
"RTN","SAMIUL",18,0)
 ; Unless required by applicable law or agreed to in writing, software
"RTN","SAMIUL",19,0)
 ; distributed under the License is distributed on an "AS IS" BASIS,
"RTN","SAMIUL",20,0)
 ; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
"RTN","SAMIUL",21,0)
 ; implied.
"RTN","SAMIUL",22,0)
 ;
"RTN","SAMIUL",23,0)
 ; See the License for the specific language governing permissions &
"RTN","SAMIUL",24,0)
 ; limitations under the License.
"RTN","SAMIUL",25,0)
 ; http://www.apache.org/licenses/LICENSE-2.0
"RTN","SAMIUL",26,0)
 ; http://www.apache.org
"RTN","SAMIUL",27,0)
 ;
"RTN","SAMIUL",28,0)
 ;
"RTN","SAMIUL",29,0)
 ;
"RTN","SAMIUL",30,0)
EOR ; end of routine SAMIUL
"VER")
8.0^22.2
**END**
**END**
