KIDS Distribution saved on Aug 13, 2020@12:12:51
SUPPORT FOR SENDING NOTES TO VISTA VIA HL7
**KIDS**:SAMI*18.0*6^

**INSTALL NAME**
SAMI*18.0*6
"BLD",10491,0)
SAMI*18.0*6^SAMI^0^3200813^y
"BLD",10491,1,0)
^^1^1^3200813^
"BLD",10491,1,1,0)
Support for sending notes to VistA via HL7
"BLD",10491,4,0)
^9.64PA^^
"BLD",10491,6.3)
1
"BLD",10491,"KRN",0)
^9.67PA^779.2^20
"BLD",10491,"KRN",.4,0)
.4
"BLD",10491,"KRN",.401,0)
.401
"BLD",10491,"KRN",.402,0)
.402
"BLD",10491,"KRN",.403,0)
.403
"BLD",10491,"KRN",.5,0)
.5
"BLD",10491,"KRN",.84,0)
.84
"BLD",10491,"KRN",3.6,0)
3.6
"BLD",10491,"KRN",3.8,0)
3.8
"BLD",10491,"KRN",9.2,0)
9.2
"BLD",10491,"KRN",9.8,0)
9.8
"BLD",10491,"KRN",9.8,"NM",0)
^9.68A^2^2
"BLD",10491,"KRN",9.8,"NM",1,0)
SAMIHOM4^^0^B626975988
"BLD",10491,"KRN",9.8,"NM",2,0)
SAMINOT1^^0^B311363583
"BLD",10491,"KRN",9.8,"NM","B","SAMIHOM4",1)

"BLD",10491,"KRN",9.8,"NM","B","SAMINOT1",2)

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

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

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

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

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

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

"BLD",10491,"KRN","B",3.6,3.6)

"BLD",10491,"KRN","B",3.8,3.8)

"BLD",10491,"KRN","B",9.2,9.2)

"BLD",10491,"KRN","B",9.8,9.8)

"BLD",10491,"KRN","B",19,19)

"BLD",10491,"KRN","B",19.1,19.1)

"BLD",10491,"KRN","B",101,101)

"BLD",10491,"KRN","B",409.61,409.61)

"BLD",10491,"KRN","B",771,771)

"BLD",10491,"KRN","B",779.2,779.2)

"BLD",10491,"KRN","B",870,870)

"BLD",10491,"KRN","B",8989.51,8989.51)

"BLD",10491,"KRN","B",8989.52,8989.52)

"BLD",10491,"KRN","B",8994,8994)

"MBREQ")
0
"PKG",230,-1)
1^1
"PKG",230,0)
SAMI^SAMI^SCREENING APPLICATIONS MANAGEMENT - IELCAP
"PKG",230,20,0)
^9.402P^^
"PKG",230,22,0)
^9.49I^1^1
"PKG",230,22,1,0)
18.0
"PKG",230,22,1,"PAH",1,0)
6^3200813
"PKG",230,22,1,"PAH",1,1,0)
^^1^1^3200813
"PKG",230,22,1,"PAH",1,1,1,0)
Support for sending notes to VistA via HL7
"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")
2
"RTN","SAMIHOM4")
0^1^B626975988
"RTN","SAMIHOM4",1,0)
SAMIHOM4 ;ven/gpl,arc - ielcap: forms;2018-11-30T17:45Z ;Jan 14, 2020@16:04
"RTN","SAMIHOM4",2,0)
 ;;18.0;SAMI;;;Build 1
"RTN","SAMIHOM4",3,0)
 ;
"RTN","SAMIHOM4",4,0)
 ;@license: see routine SAMIUL
"RTN","SAMIHOM4",5,0)
 ;
"RTN","SAMIHOM4",6,0)
 ; @section 0 primary development
"RTN","SAMIHOM4",7,0)
 ;
"RTN","SAMIHOM4",8,0)
 ; @routine-credits
"RTN","SAMIHOM4",9,0)
 ; @primary-dev: George P. Lilly (gpl)
"RTN","SAMIHOM4",10,0)
 ;  gpl@vistaexpertise.net
"RTN","SAMIHOM4",11,0)
 ; @additional-dev: Alexis Carlson (arc)
"RTN","SAMIHOM4",12,0)
 ;  alexis@vistaexpertise.net
"RTN","SAMIHOM4",13,0)
 ; @primary-dev-org: Vista Expertise Network (ven)
"RTN","SAMIHOM4",14,0)
 ;  http://vistaexpertise.net
"RTN","SAMIHOM4",15,0)
 ; @copyright: 2012/2018, ven, all rights reserved
"RTN","SAMIHOM4",16,0)
 ; @license: Apache 2.0
"RTN","SAMIHOM4",17,0)
 ;  https://www.apache.org/licenses/LICENSE-2.0.html
"RTN","SAMIHOM4",18,0)
 ;
"RTN","SAMIHOM4",19,0)
 ; @application: SAMI
"RTN","SAMIHOM4",20,0)
 ; @version: 18.0
"RTN","SAMIHOM4",21,0)
 ; @patch-list: none yet
"RTN","SAMIHOM4",22,0)
 ;
"RTN","SAMIHOM4",23,0)
 ; @to-do
"RTN","SAMIHOM4",24,0)
 ;   Add label comments
"RTN","SAMIHOM4",25,0)
 ;
"RTN","SAMIHOM4",26,0)
 ; @section 1 code
"RTN","SAMIHOM4",27,0)
 ;
"RTN","SAMIHOM4",28,0)
 quit  ; No entry from top
"RTN","SAMIHOM4",29,0)
 ;
"RTN","SAMIHOM4",30,0)
 ;
"RTN","SAMIHOM4",31,0)
WSHOME ; web service for SAMI homepage
"RTN","SAMIHOM4",32,0)
 ; WSHOME^SAMIHOM3(SAMIRTN,SAMIFILTER) goto WSHOME^SAMIHOM4
"RTN","SAMIHOM4",33,0)
 ;
"RTN","SAMIHOM4",34,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMIHOM4",35,0)
 ;
"RTN","SAMIHOM4",36,0)
 ;ven/gpl;web service;procedure;
"RTN","SAMIHOM4",37,0)
 ;@called-by
"RTN","SAMIHOM4",38,0)
 ;@calls
"RTN","SAMIHOM4",39,0)
 ; GETHOME
"RTN","SAMIHOM4",40,0)
 ;@input
"RTN","SAMIHOM4",41,0)
 ; SAMIFILTER
"RTN","SAMIHOM4",42,0)
 ;@output
"RTN","SAMIHOM4",43,0)
 ;.SAMIRTN
"RTN","SAMIHOM4",44,0)
 ;@examples [tbd]
"RTN","SAMIHOM4",45,0)
 ;@tests [tbd]
"RTN","SAMIHOM4",46,0)
 ;
"RTN","SAMIHOM4",47,0)
 ; no parameters required
"RTN","SAMIHOM4",48,0)
 ;
"RTN","SAMIHOM4",49,0)
 ;@stanza 2 present development or temporary homepage
"RTN","SAMIHOM4",50,0)
 ;
"RTN","SAMIHOM4",51,0)
 if $get(SAMIFILTER("test"))=1 do  quit
"RTN","SAMIHOM4",52,0)
 . do DEVHOME^SAMIHOM3(.SAMIRTN,.SAMIFILTER)
"RTN","SAMIHOM4",53,0)
 . quit
"RTN","SAMIHOM4",54,0)
 ;
"RTN","SAMIHOM4",55,0)
 if $g(SAMIFILTER("samiroute"))'="" do  quit  ; workaround for "get" access to pages
"RTN","SAMIHOM4",56,0)
 . new SAMIBODY set SAMIBODY(1)=""
"RTN","SAMIHOM4",57,0)
 . do WSVAPALS^SAMIHOM3(.SAMIFILTER,.SAMIBODY,.SAMIRTN)
"RTN","SAMIHOM4",58,0)
 ;
"RTN","SAMIHOM4",59,0)
 if $get(SAMIFILTER("dfn"))'="" do  quit  ; V4W/DLW - workaround for "get" access from CPRS
"RTN","SAMIHOM4",60,0)
 . new dfn set dfn=$get(SAMIFILTER("dfn"))
"RTN","SAMIHOM4",61,0)
 . new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMIHOM4",62,0)
 . new studyid set studyid=$get(@root@(dfn,"samistudyid"))
"RTN","SAMIHOM4",63,0)
 . new SAMIBODY
"RTN","SAMIHOM4",64,0)
 . if studyid'="" do
"RTN","SAMIHOM4",65,0)
 . . set SAMIBODY(1)="samiroute=casereview&dfn="_dfn_"&studyid="_studyid
"RTN","SAMIHOM4",66,0)
 . else  do
"RTN","SAMIHOM4",67,0)
 . . set SAMIBODY(1)="samiroute=lookup&dfn="_dfn_"&studyid="_studyid
"RTN","SAMIHOM4",68,0)
 . do WSVAPALS^SAMIHOM3(.SAMIFILTER,.SAMIBODY,.SAMIRTN)
"RTN","SAMIHOM4",69,0)
 ;
"RTN","SAMIHOM4",70,0)
 do GETHOME^SAMIHOM3(.SAMIRTN,.SAMIFILTER) ; VAPALS homepage
"RTN","SAMIHOM4",71,0)
 ;
"RTN","SAMIHOM4",72,0)
 ;@stanza 3 termination
"RTN","SAMIHOM4",73,0)
 ;
"RTN","SAMIHOM4",74,0)
 quit  ; end of WSHOME
"RTN","SAMIHOM4",75,0)
 ;
"RTN","SAMIHOM4",76,0)
 ;
"RTN","SAMIHOM4",77,0)
WSVAPALS ; vapals post web service - all calls come through this gateway
"RTN","SAMIHOM4",78,0)
 ; WSVAPALS^SAMIHOM3(SAMIARG,SAMIBODY,SAMIRESULT) goto WSVAPALS^SAMIHOM4
"RTN","SAMIHOM4",79,0)
 k ^SAMIUL("vapals")
"RTN","SAMIHOM4",80,0)
 m ^SAMIUL("vapals")=SAMIARG
"RTN","SAMIHOM4",81,0)
 m ^SAMIUL("vapals","BODY")=SAMIBODY
"RTN","SAMIHOM4",82,0)
 ;
"RTN","SAMIHOM4",83,0)
 new vars,SAMIBDY
"RTN","SAMIHOM4",84,0)
 set SAMIBDY=$get(SAMIBODY(1))
"RTN","SAMIHOM4",85,0)
 do parseBody^%wf("vars",.SAMIBDY)
"RTN","SAMIHOM4",86,0)
 m vars=SAMIARG
"RTN","SAMIHOM4",87,0)
 i $g(vars("siteid"))'="" d  ;
"RTN","SAMIHOM4",88,0)
 . i $g(vars("site"))'=$g(vars("siteid")) s vars("site")=$g(vars("siteid"))
"RTN","SAMIHOM4",89,0)
 m SAMIARG=vars
"RTN","SAMIHOM4",90,0)
 m SAMIARG=SAMIBODY
"RTN","SAMIHOM4",91,0)
 ;
"RTN","SAMIHOM4",92,0)
 ; Processing for multi-tenancy
"RTN","SAMIHOM4",93,0)
 ;
"RTN","SAMIHOM4",94,0)
 if '$d(vars("siteid")) d  ;
"RTN","SAMIHOM4",95,0)
 . if $g(vars("studyid"))="" q
"RTN","SAMIHOM4",96,0)
 . n sym s sym=$e(vars("studyid"),1,3) ; first 3 chars in studyid
"RTN","SAMIHOM4",97,0)
 . i $$SITENM2^SAMISITE(sym)=-1 q
"RTN","SAMIHOM4",98,0)
 . s vars("siteid")=sym
"RTN","SAMIHOM4",99,0)
 . s vars("site")=sym
"RTN","SAMIHOM4",100,0)
 ;
"RTN","SAMIHOM4",101,0)
 if $G(vars("site"))'="" d  ;
"RTN","SAMIHOM4",102,0)
 . n siteid s siteid=vars("site")
"RTN","SAMIHOM4",103,0)
 . s SAMIARG("siteid")=siteid
"RTN","SAMIHOM4",104,0)
 . s SAMIARG("sitetitle")=$$SITENM2^SAMISITE(siteid)_" - "_siteid
"RTN","SAMIHOM4",105,0)
 k ^gpl("siteselect")
"RTN","SAMIHOM4",106,0)
 m ^gpl("siteselect")=SAMIARG
"RTN","SAMIHOM4",107,0)
 m ^gpl("siteselect","vars")=vars
"RTN","SAMIHOM4",108,0)
 if $G(SAMIARG("siteid"))="" if '$$FINDSITE^SAMISITE(.SAMIRESULT,.SAMIARG) Q 0
"RTN","SAMIHOM4",109,0)
 new SAMISITE,SAMITITL
"RTN","SAMIHOM4",110,0)
 s SAMISITE=$G(SAMIARG("siteid"))
"RTN","SAMIHOM4",111,0)
 i $G(SAMIARG("sitetitle"))="" d  ;
"RTN","SAMIHOM4",112,0)
 . s SAMIARG("sitetitle")=$$SITENM2^SAMISITE(SAMISITE)_" - "_SAMISITE
"RTN","SAMIHOM4",113,0)
 s SAMITITL=$G(SAMIARG("sitetitle"))
"RTN","SAMIHOM4",114,0)
 m vars=SAMIARG
"RTN","SAMIHOM4",115,0)
 ;
"RTN","SAMIHOM4",116,0)
 k ^SAMIUL("vapals","vars")
"RTN","SAMIHOM4",117,0)
 merge ^SAMIUL("vapals","vars")=vars
"RTN","SAMIHOM4",118,0)
 merge ^SAMIUL("vapals","vars")=SAMIBODY
"RTN","SAMIHOM4",119,0)
 ;
"RTN","SAMIHOM4",120,0)
 n route s route=$g(vars("samiroute"))
"RTN","SAMIHOM4",121,0)
 i route=""  d GETHOME^SAMIHOM3(.SAMIRESULT,.SAMIARG) ; on error go home
"RTN","SAMIHOM4",122,0)
 ;
"RTN","SAMIHOM4",123,0)
 i route="lookup" d  q 0
"RTN","SAMIHOM4",124,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",125,0)
 . d WSLOOKUP^SAMISRC2(.SAMIARG,.SAMIBODY,.SAMIRESULT)
"RTN","SAMIHOM4",126,0)
 ;
"RTN","SAMIHOM4",127,0)
 i route="login" d  q 0
"RTN","SAMIHOM4",128,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",129,0)
 . d LOGIN^SAMISITE(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",130,0)
 ;
"RTN","SAMIHOM4",131,0)
 i route="home" d  q 0
"RTN","SAMIHOM4",132,0)
 . k ^gpl("home")
"RTN","SAMIHOM4",133,0)
 . m ^gpl("home")=SAMIARG
"RTN","SAMIHOM4",134,0)
 . s SAMIARG("samiroute")=""
"RTN","SAMIHOM4",135,0)
 . d WSHOME^SAMIHOM3(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",136,0)
 ;
"RTN","SAMIHOM4",137,0)
 i route="logout" d  q 0
"RTN","SAMIHOM4",138,0)
 . ;s SAMIARG("samiroute")="home"
"RTN","SAMIHOM4",139,0)
 . ;do WSVAPALS^SAMIHOM3(.SAMIFILTER,.SAMIARG,.SAMIRESULT)
"RTN","SAMIHOM4",140,0)
 . ;Q
"RTN","SAMIHOM4",141,0)
 . s SAMIARG("sitetitle")="Unknown Site"
"RTN","SAMIHOM4",142,0)
 . s SAMIARG("siteid")=""
"RTN","SAMIHOM4",143,0)
 . s SAMIARG("errorMessage")=""
"RTN","SAMIHOM4",144,0)
 . d RTNERR^SAMIHOM4(.SAMIRESULT,"vapals:login",.SAMIARG)
"RTN","SAMIHOM4",145,0)
 ;
"RTN","SAMIHOM4",146,0)
 i route="newcase" d  q 0
"RTN","SAMIHOM4",147,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",148,0)
 . d WSNEWCAS^SAMIHOM3(.SAMIARG,.SAMIBODY,.SAMIRESULT)
"RTN","SAMIHOM4",149,0)
 ;
"RTN","SAMIHOM4",150,0)
 i route="casereview" d  q 0
"RTN","SAMIHOM4",151,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",152,0)
 . d WSCASE^SAMICASE(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",153,0)
 ;
"RTN","SAMIHOM4",154,0)
 i route="nuform" d  q 0
"RTN","SAMIHOM4",155,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",156,0)
 . d WSNUFORM^SAMICASE(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",157,0)
 ;
"RTN","SAMIHOM4",158,0)
 i route="addform" d  q 0
"RTN","SAMIHOM4",159,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",160,0)
 . d WSNFPOST^SAMICASE(.SAMIARG,.SAMIBODY,.SAMIRESULT)
"RTN","SAMIHOM4",161,0)
 ;
"RTN","SAMIHOM4",162,0)
 i route="form" d  q 0
"RTN","SAMIHOM4",163,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",164,0)
 . d wsGetForm^%wf(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",165,0)
 ;
"RTN","SAMIHOM4",166,0)
 i route="postform" d  q 0
"RTN","SAMIHOM4",167,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",168,0)
 . d wsPostForm^%wf(.SAMIARG,.SAMIBODY,.SAMIRESULT)
"RTN","SAMIHOM4",169,0)
 . i $g(SAMIARG("form"))["siform" d  ;
"RTN","SAMIHOM4",170,0)
 . . n notr s notr=0 ; note return 0 if failure, 1 or greater if success
"RTN","SAMIHOM4",171,0)
 . . ; returns the ien of the note that was created and should be sent
"RTN","SAMIHOM4",172,0)
 . . s notr=$$NOTE^SAMINOT1(.SAMIARG)
"RTN","SAMIHOM4",173,0)
 . . if +notr>0 d  ;
"RTN","SAMIHOM4",174,0)
 . . . n SAMIFILTER
"RTN","SAMIHOM4",175,0)
 . . . s SAMIFILTER("sid")=$G(SAMIARG("studyid"))
"RTN","SAMIHOM4",176,0)
 . . . s SAMIFILTER("key")=$g(SAMIARG("form")) ;
"RTN","SAMIHOM4",177,0)
 . . . n tiuien
"RTN","SAMIHOM4",178,0)
 . . . s tiuien=+notr
"RTN","SAMIHOM4",179,0)
 . . . s SAMIFILTER("notenmbr")=tiuien
"RTN","SAMIHOM4",180,0)
 . . . n sendrslt
"RTN","SAMIHOM4",181,0)
 . . . ;s sendrslt="1^MSG9239010"
"RTN","SAMIHOM4",182,0)
 . . . s sendrslt=$$EN^SAMIORU(.SAMIFILTER) ; send the note to VistA
"RTN","SAMIHOM4",183,0)
 . . . i +sendrslt>0 d  ; success
"RTN","SAMIHOM4",184,0)
 . . . . n rtnid s rtnid=$p(sendrslt,"^",2) ; return id from HL7
"RTN","SAMIHOM4",185,0)
 . . . . ; post the id to the graph here
"RTN","SAMIHOM4",186,0)
 . . . . n sid s sid=$G(SAMIARG("studyid"))
"RTN","SAMIHOM4",187,0)
 . . . . n form s form=$G(SAMIARG("form"))
"RTN","SAMIHOM4",188,0)
 . . . . n nien s nien=$$NTIEN^SAMINOT1(sid,form) ; latest note ien
"RTN","SAMIHOM4",189,0)
 . . . . n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIHOM4",190,0)
 . . . . s @root@("graph",sid,form,"notes",nien,"hl7id")=rtnid
"RTN","SAMIHOM4",191,0)
 . . . . s SAMIARG("errorMessage")="Note successfully sent to VistA ID: "_rtnid
"RTN","SAMIHOM4",192,0)
 . . . else  d  ;
"RTN","SAMIHOM4",193,0)
 . . . . n rtnmsg s rtnmsg=$p(sendrslt,"^",2)
"RTN","SAMIHOM4",194,0)
 . . . . s SAMIARG("errorMessage")=rtnmsg
"RTN","SAMIHOM4",195,0)
 . . . d WSCASE^SAMICASE(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",196,0)
 . i $g(SAMIARG("form"))["fuform" d  ;
"RTN","SAMIHOM4",197,0)
 . . n notr s notr=0 ; note return 0 if failure, 1 or greater if success
"RTN","SAMIHOM4",198,0)
 . . ; returns the ien of the note that was created and should be sent
"RTN","SAMIHOM4",199,0)
 . . s notr=$$NOTE^SAMINOT2(.SAMIARG)
"RTN","SAMIHOM4",200,0)
 . . if +notr>0 d  ;
"RTN","SAMIHOM4",201,0)
 . . . n SAMIFILTER
"RTN","SAMIHOM4",202,0)
 . . . s SAMIFILTER("sid")=$G(SAMIARG("studyid"))
"RTN","SAMIHOM4",203,0)
 . . . s SAMIFILTER("key")=$g(SAMIARG("form")) ;
"RTN","SAMIHOM4",204,0)
 . . . n tiuien
"RTN","SAMIHOM4",205,0)
 . . . s tiuien=+notr
"RTN","SAMIHOM4",206,0)
 . . . s SAMIFILTER("notenmbr")=tiuien
"RTN","SAMIHOM4",207,0)
 . . . n sendrslt
"RTN","SAMIHOM4",208,0)
 . . . ;s sendrslt="0^Missing ORM Message"
"RTN","SAMIHOM4",209,0)
 . . . s sendrslt=$$EN^SAMIORU(.SAMIFILTER) ; send the note to VistA
"RTN","SAMIHOM4",210,0)
 . . . i +sendrslt>0 d  ; success
"RTN","SAMIHOM4",211,0)
 . . . . n rtnid s rtnid=$p(sendrslt,"^",2) ; return id from HL7
"RTN","SAMIHOM4",212,0)
 . . . . ; post the id to the graph here
"RTN","SAMIHOM4",213,0)
 . . . . n sid s sid=$G(SAMIARG("studyid"))
"RTN","SAMIHOM4",214,0)
 . . . . n form s form=$G(SAMIARG("form"))
"RTN","SAMIHOM4",215,0)
 . . . . n nien s nien=$$NTIEN^SAMINOT1(sid,form) ; latest note ien
"RTN","SAMIHOM4",216,0)
 . . . . n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIHOM4",217,0)
 . . . . s @root@("graph",sid,form,"notes",nien,"hl7id")=rtnid
"RTN","SAMIHOM4",218,0)
 . . . . s SAMIARG("errorMessage")="Note successfully sent to VistA ID: "_rtnid
"RTN","SAMIHOM4",219,0)
 . . . else  d  ;
"RTN","SAMIHOM4",220,0)
 . . . . n rtnmsg s rtnmsg=$p(sendrslt,"^",2)
"RTN","SAMIHOM4",221,0)
 . . . . s SAMIARG("errorMessage")=rtnmsg
"RTN","SAMIHOM4",222,0)
 . . . d WSCASE^SAMICASE(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",223,0)
 . e  d WSCASE^SAMICASE(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",224,0)
 ;
"RTN","SAMIHOM4",225,0)
 i route="deleteform" d  q 0
"RTN","SAMIHOM4",226,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",227,0)
 . d DELFORM^SAMICASE(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",228,0)
 ;
"RTN","SAMIHOM4",229,0)
 i route="ctreport" d  q 0
"RTN","SAMIHOM4",230,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",231,0)
 . n format s format="html"
"RTN","SAMIHOM4",232,0)
 . s format="text"
"RTN","SAMIHOM4",233,0)
 . i format="text" d WSNOTE^SAMINOT3(.SAMIRESULT,.SAMIARG) q  ;
"RTN","SAMIHOM4",234,0)
 . i format="html" d WSREPORT^SAMICTR0(.SAMIRESULT,.SAMIARG) q  ;
"RTN","SAMIHOM4",235,0)
 . ;d wsReport^SAMICTRT(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",236,0)
 ;
"RTN","SAMIHOM4",237,0)
 i route="note" d  q 0
"RTN","SAMIHOM4",238,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",239,0)
 . d WSNOTE^SAMINOT1(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",240,0)
 ;
"RTN","SAMIHOM4",241,0)
 i route="report" d  q 0 
"RTN","SAMIHOM4",242,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",243,0)
 . d WSREPORT^SAMIUR(.SAMIRESULT,.vars)
"RTN","SAMIHOM4",244,0)
 ;
"RTN","SAMIHOM4",245,0)
 i route="addperson" d  q 0
"RTN","SAMIHOM4",246,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",247,0)
 . n form
"RTN","SAMIHOM4",248,0)
 . s form="vapals:addperson"
"RTN","SAMIHOM4",249,0)
 . d RTNPAGE^SAMIHOM4(.SAMIRESULT,form,.SAMIARG) q  ;
"RTN","SAMIHOM4",250,0)
 ;
"RTN","SAMIHOM4",251,0)
 i route="editperson" d  q 0
"RTN","SAMIHOM4",252,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",253,0)
 . n dfn s dfn=$g(vars("dfn")) ; must have a dfn
"RTN","SAMIHOM4",254,0)
 . i dfn="" d  q  ;
"RTN","SAMIHOM4",255,0)
 . . d GETHOME^SAMIHOM3(.SAMIRESULT,.SAMIARG) ; on error go home 
"RTN","SAMIHOM4",256,0)
 . n root s root=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",257,0)
 . n sien s sien=$o(@root@("dfn",dfn,""))
"RTN","SAMIHOM4",258,0)
 . i sien="" d  q  ;
"RTN","SAMIHOM4",259,0)
 . . d GETHOME^SAMIHOM3(.SAMIRESULT,.SAMIARG) ; on error go home 
"RTN","SAMIHOM4",260,0)
 . s vars("name")=$g(@root@(sien,"saminame"))
"RTN","SAMIHOM4",261,0)
 . s tdob=$g(@root@(sien,"dob"))
"RTN","SAMIHOM4",262,0)
 . s vars("dob")=$p(tdob,"-",2)_"/"_$p(tdob,"-",3)_"/"_$p(tdob,"-",1)
"RTN","SAMIHOM4",263,0)
 . s vars("sbdob")=$g(@root@(sien,"dob"))
"RTN","SAMIHOM4",264,0)
 . s vars("gender")=$g(@root@(sien,"sex"))
"RTN","SAMIHOM4",265,0)
 . s vars("icn")=$g(@root@(sien,"icn"))
"RTN","SAMIHOM4",266,0)
 . n tssn s tssn=$g(@root@(sien,"ssn"))
"RTN","SAMIHOM4",267,0)
 . s vars("ssn")=$e(tssn,1,3)_"-"_$e(tssn,4,5)_"-"_$e(tssn,6,9)
"RTN","SAMIHOM4",268,0)
 . s vars("last5")=$g(@root@(sien,"last5"))
"RTN","SAMIHOM4",269,0)
 . s vars("dfn")=$g(@root@(sien,"dfn"))
"RTN","SAMIHOM4",270,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",271,0)
 . n form,err,zhtml
"RTN","SAMIHOM4",272,0)
 . s form="vapals:editparticipant"
"RTN","SAMIHOM4",273,0)
 . d RTNPAGE^SAMIHOM4(.SAMIRESULT,form,.SAMIARG) q  ;
"RTN","SAMIHOM4",274,0)
 ;
"RTN","SAMIHOM4",275,0)
 i route="register" d  q 0
"RTN","SAMIHOM4",276,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",277,0)
 . d REG^SAMIHOM4(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",278,0)
 ; 
"RTN","SAMIHOM4",279,0)
 i route="editsave" d  q 0
"RTN","SAMIHOM4",280,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",281,0)
 . d SAVE^SAMIHOM4(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",282,0)
 ;
"RTN","SAMIHOM4",283,0)
 i route="merge" d  q 0
"RTN","SAMIHOM4",284,0)
 . m SAMIARG=vars
"RTN","SAMIHOM4",285,0)
 . d MERGE^SAMIHOM4(.SAMIRESULT,.SAMIARG)
"RTN","SAMIHOM4",286,0)
 ;
"RTN","SAMIHOM4",287,0)
 quit 0  ; End of WSVAPALS
"RTN","SAMIHOM4",288,0)
 ;
"RTN","SAMIHOM4",289,0)
 ;
"RTN","SAMIHOM4",290,0)
REG(SAMIRTN,SAMIARG) ; manual registration
"RTN","SAMIHOM4",291,0)
 ;
"RTN","SAMIHOM4",292,0)
 n name s name=$g(SAMIARG("name"))
"RTN","SAMIHOM4",293,0)
 ;
"RTN","SAMIHOM4",294,0)
 m ^gpl("reg")=SAMIARG
"RTN","SAMIHOM4",295,0)
 n ssn s ssn=SAMIARG("ssn")
"RTN","SAMIHOM4",296,0)
 s ssn=$tr(ssn,"-")
"RTN","SAMIHOM4",297,0)
 s SAMIARG("errorMessage")=""
"RTN","SAMIHOM4",298,0)
 s SAMIARG("errorField")=""
"RTN","SAMIHOM4",299,0)
 ; test for duplicate ssn
"RTN","SAMIHOM4",300,0)
 ;
"RTN","SAMIHOM4",301,0)
 i $$DUPSSN(ssn) d  ;
"RTN","SAMIHOM4",302,0)
 . ;s SAMIARG("errorMessage")=SAMIARG("errorMessage")_" Duplicate SSN."
"RTN","SAMIHOM4",303,0)
 . s SAMIARG("errorMessage")=SAMIARG("errorMessage")_" Duplicate SSN error. A person with that SSN is already entered in the system."
"RTN","SAMIHOM4",304,0)
 . s SAMIARG("errorField")="ssn"
"RTN","SAMIHOM4",305,0)
 ;
"RTN","SAMIHOM4",306,0)
 ; test for duplicate icn
"RTN","SAMIHOM4",307,0)
 ;
"RTN","SAMIHOM4",308,0)
 ;n icn s icn=$g(SAMIARG("icn"))
"RTN","SAMIHOM4",309,0)
 ;i icn'="" i $$DUPICN(icn) d  ;
"RTN","SAMIHOM4",310,0)
 ;. s SAMIARG("errorMessage")=SAMIARG("errorMessage")_" Duplicate ICN error. A person with that ICN is already entered in the system."
"RTN","SAMIHOM4",311,0)
 ;. s SAMIARG("errorField")="icn"
"RTN","SAMIHOM4",312,0)
 ;;
"RTN","SAMIHOM4",313,0)
 ;; test for wellformed ICN
"RTN","SAMIHOM4",314,0)
 ;;
"RTN","SAMIHOM4",315,0)
 ;i icn'="" i $$BADICN(icn) d  ;
"RTN","SAMIHOM4",316,0)
 ;. s SAMIARG("errorMessage")=SAMIARG("errorMessage")_" Invalid ICN error. The check digits in the ICN do not match"
"RTN","SAMIHOM4",317,0)
 ;. s SAMIARG("errorField")="icn"
"RTN","SAMIHOM4",318,0)
 ;;
"RTN","SAMIHOM4",319,0)
 ; if there is an error, send back to edit with error message
"RTN","SAMIHOM4",320,0)
 i $g(SAMIARG("errorMessage"))'="" d  q  ;
"RTN","SAMIHOM4",321,0)
 . n form
"RTN","SAMIHOM4",322,0)
 . s form="vapals:addperson"
"RTN","SAMIHOM4",323,0)
 . d RTNERR(.SAMIRESULT,form,.SAMIARG)
"RTN","SAMIHOM4",324,0)
 ;
"RTN","SAMIHOM4",325,0)
 n root s root=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",326,0)
 n proot s proot=$$setroot^%wd("vapals-patients")
"RTN","SAMIHOM4",327,0)
 n ptlkien s ptlkien=""
"RTN","SAMIHOM4",328,0)
 n dfn s dfn=""
"RTN","SAMIHOM4",329,0)
 n sien s sien=""
"RTN","SAMIHOM4",330,0)
 i ptlkien="" s ptlkien=$o(@root@("AAAAAA"),-1)+1
"RTN","SAMIHOM4",331,0)
 n zm
"RTN","SAMIHOM4",332,0)
 k SAMIARG("MATCHLOG")
"RTN","SAMIHOM4",333,0)
 s zm=$$REMATCH(sien,.SAMIARG)
"RTN","SAMIHOM4",334,0)
 i zm>0 d  ;
"RTN","SAMIHOM4",335,0)
 . s SAMIARG("MATCHLOG")=zm
"RTN","SAMIHOM4",336,0)
 d MKPTLK(ptlkien,.SAMIARG) ; make the patient-lookup record
"RTN","SAMIHOM4",337,0)
 ;
"RTN","SAMIHOM4",338,0)
 s dfn=$o(@root@("dfn"," "),-1)+1
"RTN","SAMIHOM4",339,0)
 n pdfn
"RTN","SAMIHOM4",340,0)
 s pdfn=$o(@proot@("dfn"," "),-1)+1
"RTN","SAMIHOM4",341,0)
 i pdfn>dfn s dfn=pdfn ; need a dfn that has not been used
"RTN","SAMIHOM4",342,0)
 i dfn<9000001 s dfn=9000001
"RTN","SAMIHOM4",343,0)
 s @root@(ptlkien,"dfn")=dfn
"RTN","SAMIHOM4",344,0)
 d INDXPTLK(ptlkien)
"RTN","SAMIHOM4",345,0)
 s SAMIFILTER("samiroute")="addperson"
"RTN","SAMIHOM4",346,0)
 s SAMIFILTER("siteid")=$G(SAMIARG("siteid"))
"RTN","SAMIHOM4",347,0)
 s SAMIFILTER("sitetitle")=$G(SAMIARG("sitetitle"))
"RTN","SAMIHOM4",348,0)
 k SAMIARG ; return to a blank manual registration form
"RTN","SAMIHOM4",349,0)
 s SAMIARG("siteid")=$G(SAMIFILTER("siteid"))
"RTN","SAMIHOM4",350,0)
 s SAMIARG("sitetitle")=$G(SAMIFILTER("sitetitle"))
"RTN","SAMIHOM4",351,0)
 d SETINFO(.SAMIFILTER,name_" was successfully entered")
"RTN","SAMIHOM4",352,0)
 ;d SETWARN(.SAMIFILTER,"We might want to give you a warning")
"RTN","SAMIHOM4",353,0)
 do WSVAPALS^SAMIHOM3(.SAMIFILTER,.SAMIARG,.SAMIRESULT)
"RTN","SAMIHOM4",354,0)
 q
"RTN","SAMIHOM4",355,0)
 ;
"RTN","SAMIHOM4",356,0)
MKPTLK(ptlkien,SAMIARG) ; creates the patient-lookup record
"RTN","SAMIHOM4",357,0)
 n ssn s ssn=SAMIARG("ssn")
"RTN","SAMIHOM4",358,0)
 s ssn=$tr(ssn,"-")
"RTN","SAMIHOM4",359,0)
 n name s name=$g(SAMIARG("name"))
"RTN","SAMIHOM4",360,0)
 n sinamef,sinamel
"RTN","SAMIHOM4",361,0)
 s sinamel=$p(name,","),sinamel=$$TRIM^XLFSTR(sinamel,"LR")
"RTN","SAMIHOM4",362,0)
 s sinamef=$p(name,",",2),sinamef=$$TRIM^XLFSTR(sinamef,"LR")
"RTN","SAMIHOM4",363,0)
 s name=sinamel_","_sinamef
"RTN","SAMIHOM4",364,0)
 n siteid s siteid=$g(SAMIARG("siteid"))
"RTN","SAMIHOM4",365,0)
 i siteid="" s siteid=$g(SAMIARG("site"))
"RTN","SAMIHOM4",366,0)
 ;
"RTN","SAMIHOM4",367,0)
 s @root@(ptlkien,"siteid")=siteid
"RTN","SAMIHOM4",368,0)
 s @root@(ptlkien,"saminame")=name
"RTN","SAMIHOM4",369,0)
 s @root@(ptlkien,"sinamef")=sinamef
"RTN","SAMIHOM4",370,0)
 s @root@(ptlkien,"sinamel")=sinamel
"RTN","SAMIHOM4",371,0)
 n fmdob s fmdob=$$FMDT^SAMIUR2(SAMIARG("dob"))
"RTN","SAMIHOM4",372,0)
 n ptlkdob s ptlkdob=$$FMTE^XLFDT(fmdob,7)
"RTN","SAMIHOM4",373,0)
 s ptlkdob=$TR(ptlkdob,"/","-")
"RTN","SAMIHOM4",374,0)
 s @root@(ptlkien,"dob")=ptlkdob
"RTN","SAMIHOM4",375,0)
 s @root@(ptlkien,"sbdob")=ptlkdob
"RTN","SAMIHOM4",376,0)
 n gender s gender=SAMIARG("gender")
"RTN","SAMIHOM4",377,0)
 s @root@(ptlkien,"gender")=$s(gender="M":"M^MALE",1:"F^FEMALE")
"RTN","SAMIHOM4",378,0)
 s @root@(ptlkien,"sex")=SAMIARG("gender")
"RTN","SAMIHOM4",379,0)
 s @root@(ptlkien,"icn")=SAMIARG("icn")
"RTN","SAMIHOM4",380,0)
 s @root@(ptlkien,"ssn")=ssn
"RTN","SAMIHOM4",381,0)
 n last5 s last5=$$UCASE($e(name,1))_$e(ssn,6,9)
"RTN","SAMIHOM4",382,0)
 s @root@(ptlkien,"last5")=last5
"RTN","SAMIHOM4",383,0)
 n mymatch s mymatch=$g(SAMIARG("MATCHLOG"))
"RTN","SAMIHOM4",384,0)
 i mymatch'="" s @root@(ptlkien,"MATCHLOG")=mymatch
"RTN","SAMIHOM4",385,0)
 q
"RTN","SAMIHOM4",386,0)
 ;
"RTN","SAMIHOM4",387,0)
UPDTFRMS(dfn) ; update demographics in all patient forms for patient dfn
"RTN","SAMIHOM4",388,0)
 ;
"RTN","SAMIHOM4",389,0)
 n lroot s lroot=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",390,0)
 n proot s proot=$$setroot^%wd("vapals-patients")
"RTN","SAMIHOM4",391,0)
 n lien s lien=$o(@lroot@("dfn",dfn,""))
"RTN","SAMIHOM4",392,0)
 q:lien=""
"RTN","SAMIHOM4",393,0)
 n pien s pien=$o(@proot@("dfn",dfn,""))
"RTN","SAMIHOM4",394,0)
 q:pien=""
"RTN","SAMIHOM4",395,0)
 ; this patient has forms
"RTN","SAMIHOM4",396,0)
 m @proot@(pien)=@lroot@(lien) ; refresh the demos in the patient record
"RTN","SAMIHOM4",397,0)
 n ssn s ssn=$g(@proot@(pien,"ssn"))
"RTN","SAMIHOM4",398,0)
 s @proot@(pien,"sissn")=$e(ssn,1,3)_"-"_$e(ssn,4,5)_"-"_$e(ssn,6,9)
"RTN","SAMIHOM4",399,0)
 n sid s sid=$g(@proot@("sisid")) ; studyid 
"RTN","SAMIHOM4",400,0)
 q:sid=""  ; no studyid
"RTN","SAMIHOM4",401,0)
 n zi s zi=""
"RTN","SAMIHOM4",402,0)
 f  s zi=$o(@proot@("graph",sid,zi)) q:zi=""  d  ; for each form
"RTN","SAMIHOM4",403,0)
 . m @proot@("graph",sid,zi)=@proot@(pien) ; stamp each form with new demos
"RTN","SAMIHOM4",404,0)
 q
"RTN","SAMIHOM4",405,0)
 ;
"RTN","SAMIHOM4",406,0)
MERGE(SAMIRESULT,SAMIARGS) ; merge participant records
"RTN","SAMIHOM4",407,0)
 ; called from pressing the merge button on the unmatched report
"RTN","SAMIHOM4",408,0)
 n toien s toien=$g(SAMIARGS("toien"))
"RTN","SAMIHOM4",409,0)
 i toien="" d  q  ;
"RTN","SAMIHOM4",410,0)
 . d WSUNMAT(.SAMIRESULT,.SAMIARGS)
"RTN","SAMIHOM4",411,0)
 n lroot s lroot=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",412,0)
 n fromien s fromien=$g(@lroot@(toien,"MATCHLOG"))
"RTN","SAMIHOM4",413,0)
 i fromien="" d  q  ;
"RTN","SAMIHOM4",414,0)
 . d WSUNMAT(.SAMIRESULT,.SAMIARGS)
"RTN","SAMIHOM4",415,0)
 ;
"RTN","SAMIHOM4",416,0)
 ; test for remotedfn in from record - not valid if absent
"RTN","SAMIHOM4",417,0)
 ;
"RTN","SAMIHOM4",418,0)
 i $g(@lroot@(fromien,"remotedfn"))="" d  q  ;
"RTN","SAMIHOM4",419,0)
 . d WSUNMAT(.SAMIRESULT,.SAMIARGS)
"RTN","SAMIHOM4",420,0)
 ;
"RTN","SAMIHOM4",421,0)
 ; remove index entries for from and to records
"RTN","SAMIHOM4",422,0)
 ;
"RTN","SAMIHOM4",423,0)
 d UNINDXPT(fromien) ; delete index entries
"RTN","SAMIHOM4",424,0)
 d UNINDXPT(toien)
"RTN","SAMIHOM4",425,0)
 ;
"RTN","SAMIHOM4",426,0)
 ; create changelog entry in to record - contains from record
"RTN","SAMIHOM4",427,0)
 ;
"RTN","SAMIHOM4",428,0)
 m @lroot@(toien,"changelog",$$FMTE^XLFDT($$NOW^XLFDT,5))=@lroot@(fromien)
"RTN","SAMIHOM4",429,0)
 ;
"RTN","SAMIHOM4",430,0)
 ; change the dfn in the from record to the to record dfn for merging
"RTN","SAMIHOM4",431,0)
 ;
"RTN","SAMIHOM4",432,0)
 s @lroot@(fromien,"dfn")=@lroot@(toien,"dfn")
"RTN","SAMIHOM4",433,0)
 n dfn s dfn=@lroot@(toien,"dfn") ; for use in updating forms
"RTN","SAMIHOM4",434,0)
 ;
"RTN","SAMIHOM4",435,0)
 ; merge the from record to the to record
"RTN","SAMIHOM4",436,0)
 ;
"RTN","SAMIHOM4",437,0)
 m @lroot@(toien)=@lroot@(fromien)
"RTN","SAMIHOM4",438,0)
 ;
"RTN","SAMIHOM4",439,0)
 ; delete the from record
"RTN","SAMIHOM4",440,0)
 ;
"RTN","SAMIHOM4",441,0)
 k @lroot@(fromien)
"RTN","SAMIHOM4",442,0)
 ;
"RTN","SAMIHOM4",443,0)
 ; reindex the to record
"RTN","SAMIHOM4",444,0)
 ;
"RTN","SAMIHOM4",445,0)
 d INDXPTLK(toien)
"RTN","SAMIHOM4",446,0)
 ;
"RTN","SAMIHOM4",447,0)
 ; propagate the updated from record to every form
"RTN","SAMIHOM4",448,0)
 ;
"RTN","SAMIHOM4",449,0)
 d UPDTFRMS(dfn) ; updates the patient in the vapals-patient graph
"RTN","SAMIHOM4",450,0)
 ;
"RTN","SAMIHOM4",451,0)
 ; leave and return to the unmatched report
"RTN","SAMIHOM4",452,0)
 ;   note that the form and to records will no longer be in the report
"RTN","SAMIHOM4",453,0)
 ;
"RTN","SAMIHOM4",454,0)
 d WSUNMAT(.SAMIRESULT,.SAMIARGS)
"RTN","SAMIHOM4",455,0)
 ;
"RTN","SAMIHOM4",456,0)
 q
"RTN","SAMIHOM4",457,0)
 ;
"RTN","SAMIHOM4",458,0)
ADDUNMAT ; adds the unmatched report web service to the system
"RTN","SAMIHOM4",459,0)
 ;
"RTN","SAMIHOM4",460,0)
 d addService^%webutils("GET","unmatched","WSUNMAT^SAMIHOM4")
"RTN","SAMIHOM4",461,0)
 q
"RTN","SAMIHOM4",462,0)
 ;
"RTN","SAMIHOM4",463,0)
DELUNMAT ; deletes the unmatched web service
"RTN","SAMIHOM4",464,0)
 ;
"RTN","SAMIHOM4",465,0)
 d deleteService^%webutils("GET","unmatched")
"RTN","SAMIHOM4",466,0)
 q
"RTN","SAMIHOM4",467,0)
 ;
"RTN","SAMIHOM4",468,0)
WSUNMAT(SAMIRESULT,SAMIARGS) ; navigates to unmatched report
"RTN","SAMIHOM4",469,0)
 ; 
"RTN","SAMIHOM4",470,0)
 n filter,bdy
"RTN","SAMIHOM4",471,0)
 s bdy=""
"RTN","SAMIHOM4",472,0)
 ;s filter("siteid")="PHX"
"RTN","SAMIHOM4",473,0)
 s filter("samiroute")="report"
"RTN","SAMIHOM4",474,0)
 s filter("samireporttype")="unmatched"
"RTN","SAMIHOM4",475,0)
 d WSVAPALS^SAMIHOM3(.filter,.bdy,.SAMIRESULT) ; back to the unmatched report
"RTN","SAMIHOM4",476,0)
 q
"RTN","SAMIHOM4",477,0)
 ;
"RTN","SAMIHOM4",478,0)
DUPSSN(ssn) ; extrinsic returns true if duplicate ssn
"RTN","SAMIHOM4",479,0)
 n proot s proot=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",480,0)
 i $d(@proot@("ssn",ssn)) q 1
"RTN","SAMIHOM4",481,0)
 q 0
"RTN","SAMIHOM4",482,0)
 ;
"RTN","SAMIHOM4",483,0)
DUPICN(icn) ; extrinsic returns true if duplicate icn
"RTN","SAMIHOM4",484,0)
 n proot s proot=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",485,0)
 n tmpicn s tmpicn=$p(icn,"V",1)
"RTN","SAMIHOM4",486,0)
 i $d(@proot@("icn",icn)) q 1
"RTN","SAMIHOM4",487,0)
 i $d(@proot@("icn",tmpicn)) q 1
"RTN","SAMIHOM4",488,0)
 q 0
"RTN","SAMIHOM4",489,0)
 ;
"RTN","SAMIHOM4",490,0)
BADICN(icn) ; extrinsic returns true if ICN checkdigits are wrong
"RTN","SAMIHOM4",491,0)
 n zchk s zchk=$p(icn,"V",2)
"RTN","SAMIHOM4",492,0)
 n zicn s zicn=$p(icn,"V",1)
"RTN","SAMIHOM4",493,0)
 q:zchk="" 1
"RTN","SAMIHOM4",494,0)
 i zchk'=$$CHECKDG^MPIFSPC(zicn) q 1
"RTN","SAMIHOM4",495,0)
 q 0
"RTN","SAMIHOM4",496,0)
 ;
"RTN","SAMIHOM4",497,0)
SAVE(SAMIRESULT,SAMIARG) ; save patient-lookup record after edit
"RTN","SAMIHOM4",498,0)
 ;
"RTN","SAMIHOM4",499,0)
 n dfn s dfn=$g(vars("dfn")) ; must have a dfn
"RTN","SAMIHOM4",500,0)
 i dfn="" d  q  ;
"RTN","SAMIHOM4",501,0)
 . d GETHOME^SAMIHOM3(.SAMIRESULT,.SAMIARG) ; on error go home 
"RTN","SAMIHOM4",502,0)
 n root s root=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",503,0)
 n sien s sien=$o(@root@("dfn",dfn,""))
"RTN","SAMIHOM4",504,0)
 i sien="" d  q  ;
"RTN","SAMIHOM4",505,0)
 . d GETHOME^SAMIHOM3(.SAMIRESULT,.SAMIARG) ; on error go home 
"RTN","SAMIHOM4",506,0)
 d UNINDXPT(sien) ; remove old index entries
"RTN","SAMIHOM4",507,0)
 n zm
"RTN","SAMIHOM4",508,0)
 k SAMIARG("MATCHLOG")
"RTN","SAMIHOM4",509,0)
 s zm=$$REMATCH(sien,.SAMIARG)
"RTN","SAMIHOM4",510,0)
 i zm>0 d  ;
"RTN","SAMIHOM4",511,0)
 . s SAMIARG("MATCHLOG")=zm
"RTN","SAMIHOM4",512,0)
 d MKPTLK(sien,.SAMIARG) ; add the updated fields
"RTN","SAMIHOM4",513,0)
 d INDXPTLK(sien) ; create new index entries
"RTN","SAMIHOM4",514,0)
 d UPDTFRMS(dfn) ; update demographic info in all forms
"RTN","SAMIHOM4",515,0)
 n filter,bdy
"RTN","SAMIHOM4",516,0)
 s bdy=""
"RTN","SAMIHOM4",517,0)
 m filter=SAMIARG
"RTN","SAMIHOM4",518,0)
 s filter("samiroute")="report"
"RTN","SAMIHOM4",519,0)
 s filter("samireporttype")="unmatched"
"RTN","SAMIHOM4",520,0)
 d WSVAPALS^SAMIHOM3(.filter,.bdy,.SAMIRESULT) ; back to the unmatched report
"RTN","SAMIHOM4",521,0)
 q
"RTN","SAMIHOM4",522,0)
 ;
"RTN","SAMIHOM4",523,0)
REMATCH(sien,SAMIARG) ; extrinsic returns a possible match ien
"RTN","SAMIHOM4",524,0)
 ; else zero
"RTN","SAMIHOM4",525,0)
 n lroot s lroot=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",526,0)
 n ssn,name,icn,x,y
"RTN","SAMIHOM4",527,0)
 s ssn=$g(SAMIARG("ssn"))
"RTN","SAMIHOM4",528,0)
 i ssn["-" s ssn=$tr(ssn,"-")
"RTN","SAMIHOM4",529,0)
 s name=$g(SAMIARG("saminame"))
"RTN","SAMIHOM4",530,0)
 i name="" s name=$g(SAMIARG("name"))
"RTN","SAMIHOM4",531,0)
 s icn=$g(SAMIARG("icn"))
"RTN","SAMIHOM4",532,0)
 s x=0
"RTN","SAMIHOM4",533,0)
 i ssn'="" s x=$o(@lroot@("ssn",ssn,""))
"RTN","SAMIHOM4",534,0)
 i x=sien s x=$o(@lroot@("ssn",ssn,x))
"RTN","SAMIHOM4",535,0)
 i +x'=0 d  ;
"RTN","SAMIHOM4",536,0)
 . s y=$g(@lroot@(x,"dfn"))
"RTN","SAMIHOM4",537,0)
 . i y>9000000 s x=0
"RTN","SAMIHOM4",538,0)
 i x>0 q x
"RTN","SAMIHOM4",539,0)
 i name'="" s x=$o(@lroot@("name",name,""))
"RTN","SAMIHOM4",540,0)
 i x=sien s x=$o(@lroot@("name",name,x))
"RTN","SAMIHOM4",541,0)
 i +x'=0 d  ;
"RTN","SAMIHOM4",542,0)
 . s y=$g(@lroot@(x,"dfn"))
"RTN","SAMIHOM4",543,0)
 . i y>9000000 s x=0
"RTN","SAMIHOM4",544,0)
 i x>0 q x
"RTN","SAMIHOM4",545,0)
 ;i icn'="" s x=$o(@lroot@("icn",icn,""))
"RTN","SAMIHOM4",546,0)
 ;i x=sien s x=$o(@lroot@("icn",icn,x))
"RTN","SAMIHOM4",547,0)
 ;i +x'=0 d  ;
"RTN","SAMIHOM4",548,0)
 ;. s y=$g(@lroot@(x,"dfn"))
"RTN","SAMIHOM4",549,0)
 ;. i y>9000000 s x=0
"RTN","SAMIHOM4",550,0)
 ;i x>0 q x
"RTN","SAMIHOM4",551,0)
 q 0
"RTN","SAMIHOM4",552,0)
 ;
"RTN","SAMIHOM4",553,0)
SETINFO(vars,msg) ; set the information message text
"RTN","SAMIHOM4",554,0)
 ; vars are the screen variables passed by reference
"RTN","SAMIHOM4",555,0)
 s vars("infoMessage")=msg
"RTN","SAMIHOM4",556,0)
 q
"RTN","SAMIHOM4",557,0)
 ;
"RTN","SAMIHOM4",558,0)
SETWARN(vars,msg) ; set warning message text
"RTN","SAMIHOM4",559,0)
 ; vars are the screen variables passed by reference
"RTN","SAMIHOM4",560,0)
 s vars("warnMessage")=msg
"RTN","SAMIHOM4",561,0)
 q
"RTN","SAMIHOM4",562,0)
 ; 
"RTN","SAMIHOM4",563,0)
RTNERR(rtn,form,vals,msg,fld) ; redisplays a page with an error message
"RTN","SAMIHOM4",564,0)
 ; rtn is the return array
"RTN","SAMIHOM4",565,0)
 ; form is the form the page requires
"RTN","SAMIHOM4",566,0)
 ; vals are the values for the page. passed by reference
"RTN","SAMIHOM4",567,0)
 ; msg is the error message to be displayed
"RTN","SAMIHOM4",568,0)
 ; fld is the name of the field where the cursor should be put
"RTN","SAMIHOM4",569,0)
 ;
"RTN","SAMIHOM4",570,0)
 n zhtml ; work area for the tempate
"RTN","SAMIHOM4",571,0)
 d SAMIHTM^%wf(.zhtml,form,.err)
"RTN","SAMIHOM4",572,0)
 d MERGEHTM^%wf(.zhtml,.vals,.err)
"RTN","SAMIHOM4",573,0)
 m rtn=zhtml
"RTN","SAMIHOM4",574,0)
 set HTTPRSP("mime")="text/html" ; set mime type
"RTN","SAMIHOM4",575,0)
 q
"RTN","SAMIHOM4",576,0)
 ;
"RTN","SAMIHOM4",577,0)
RTNPAGE(rtn,form,vals) ; displays a page
"RTN","SAMIHOM4",578,0)
 ; rtn is the return array
"RTN","SAMIHOM4",579,0)
 ; form is the form the page requires
"RTN","SAMIHOM4",580,0)
 ; vals are the values for the page. passed by reference
"RTN","SAMIHOM4",581,0)
 ;
"RTN","SAMIHOM4",582,0)
 n err
"RTN","SAMIHOM4",583,0)
 n zhtml ; work area for the tempate
"RTN","SAMIHOM4",584,0)
 d SAMIHTM^%wf(.zhtml,form,.err)
"RTN","SAMIHOM4",585,0)
 d MERGEHTM^%wf(.zhtml,.vals,.err)
"RTN","SAMIHOM4",586,0)
 m SAMIRESULT=zhtml
"RTN","SAMIHOM4",587,0)
 set HTTPRSP("mime")="text/html" ; set mime type
"RTN","SAMIHOM4",588,0)
 q
"RTN","SAMIHOM4",589,0)
 ;
"RTN","SAMIHOM4",590,0)
REINDXPL ; reindex patient lookup
"RTN","SAMIHOM4",591,0)
 n root s root=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",592,0)
 n zi s zi=0
"RTN","SAMIHOM4",593,0)
 k @root@("ssn")
"RTN","SAMIHOM4",594,0)
 k @root@("name")
"RTN","SAMIHOM4",595,0)
 k @root@("last5")
"RTN","SAMIHOM4",596,0)
 k @root@("sinamef")
"RTN","SAMIHOM4",597,0)
 k @root@("sinamel")
"RTN","SAMIHOM4",598,0)
 k @root@("icn")
"RTN","SAMIHOM4",599,0)
 f  s zi=$o(@root@(zi)) q:+zi=0  d  ;
"RTN","SAMIHOM4",600,0)
 . d INDXPTLK(zi)
"RTN","SAMIHOM4",601,0)
 q
"RTN","SAMIHOM4",602,0)
 ;
"RTN","SAMIHOM4",603,0)
INDXPTLK(ien) ; generate index entries in patient-lookup graph
"RTN","SAMIHOM4",604,0)
 ; for entry ien
"RTN","SAMIHOM4",605,0)
 n proot set proot=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",606,0)
 n name s name=$g(@proot@(ien,"saminame"))
"RTN","SAMIHOM4",607,0)
 s @proot@("name",name,ien)=""
"RTN","SAMIHOM4",608,0)
 n ucname s ucname=$$UCASE(name)
"RTN","SAMIHOM4",609,0)
 s @proot@("name",ucname,ien)=""
"RTN","SAMIHOM4",610,0)
 n x
"RTN","SAMIHOM4",611,0)
 s x=$g(@proot@(ien,"dfn")) ;w !,x
"RTN","SAMIHOM4",612,0)
 s:x'="" @proot@("dfn",x,ien)=""
"RTN","SAMIHOM4",613,0)
 s x=$g(@proot@(ien,"last5")) ;w !,x
"RTN","SAMIHOM4",614,0)
 s:x'="" @proot@("last5",x,ien)=""
"RTN","SAMIHOM4",615,0)
 s x=$g(@proot@(ien,"icn")) ;w !,x
"RTN","SAMIHOM4",616,0)
 i x'["V" d  ;
"RTN","SAMIHOM4",617,0)
 . i x="" q
"RTN","SAMIHOM4",618,0)
 . n chk s chk=$$CHECKDG^MPIFSPC(x)
"RTN","SAMIHOM4",619,0)
 . s @proot@(ien,"icn")=x_"V"_chk
"RTN","SAMIHOM4",620,0)
 . s x=x_"V"_chk
"RTN","SAMIHOM4",621,0)
 s:x'="" @proot@("icn",x,ien)=""
"RTN","SAMIHOM4",622,0)
 s x=$g(@proot@(ien,"ssn")) ;w !,x
"RTN","SAMIHOM4",623,0)
 s:x'="" @proot@("ssn",x,ien)=""
"RTN","SAMIHOM4",624,0)
 s x=$g(@proot@(ien,"sinamef")) ;w !,x
"RTN","SAMIHOM4",625,0)
 s:x'="" @proot@("sinamef",x,ien)=""
"RTN","SAMIHOM4",626,0)
 s x=$g(@proot@(ien,"sinamel")) w !,x
"RTN","SAMIHOM4",627,0)
 s:x'="" @proot@("sinamel",x,ien)=""
"RTN","SAMIHOM4",628,0)
 set @proot@("Date Last Updated")=$$HTE^XLFDT($horolog)
"RTN","SAMIHOM4",629,0)
 q
"RTN","SAMIHOM4",630,0)
 ;
"RTN","SAMIHOM4",631,0)
UNINDXPT(ien) ; remove index entries in patient-lookup graph
"RTN","SAMIHOM4",632,0)
 ; for entry ien
"RTN","SAMIHOM4",633,0)
 n proot set proot=$$setroot^%wd("patient-lookup")
"RTN","SAMIHOM4",634,0)
 n name s name=$g(@proot@(ien,"saminame"))
"RTN","SAMIHOM4",635,0)
 k @proot@("name",name,ien)
"RTN","SAMIHOM4",636,0)
 n ucname s ucname=$$UCASE(name)
"RTN","SAMIHOM4",637,0)
 k @proot@("name",ucname,ien)
"RTN","SAMIHOM4",638,0)
 n x
"RTN","SAMIHOM4",639,0)
 s x=$g(@proot@(ien,"dfn")) ;w !,x
"RTN","SAMIHOM4",640,0)
 k:x'="" @proot@("dfn",x,ien)
"RTN","SAMIHOM4",641,0)
 s x=$g(@proot@(ien,"last5")) ;w !,x
"RTN","SAMIHOM4",642,0)
 k:x'="" @proot@("last5",x,ien)
"RTN","SAMIHOM4",643,0)
 s x=$g(@proot@(ien,"icn")) ;w !,x
"RTN","SAMIHOM4",644,0)
 i x'["V" d  ;
"RTN","SAMIHOM4",645,0)
 . i x="" q
"RTN","SAMIHOM4",646,0)
 . n chk s chk=$$CHECKDG^MPIFSPC(x)
"RTN","SAMIHOM4",647,0)
 . s @proot@(ien,"icn")=x_"V"_chk
"RTN","SAMIHOM4",648,0)
 . s x=x_"V"_chk
"RTN","SAMIHOM4",649,0)
 k:x'="" @proot@("icn",x,ien)
"RTN","SAMIHOM4",650,0)
 s x=$g(@proot@(ien,"ssn")) ;w !,x
"RTN","SAMIHOM4",651,0)
 k:x'="" @proot@("ssn",x,ien)
"RTN","SAMIHOM4",652,0)
 s x=$g(@proot@(ien,"sinamef")) ;w !,x
"RTN","SAMIHOM4",653,0)
 k:x'="" @proot@("sinamef",x,ien)
"RTN","SAMIHOM4",654,0)
 s x=$g(@proot@(ien,"sinamel")) w !,x
"RTN","SAMIHOM4",655,0)
 k:x'="" @proot@("sinamel",x,ien)
"RTN","SAMIHOM4",656,0)
 set @proot@("Date Last Updated")=$$HTE^XLFDT($horolog)
"RTN","SAMIHOM4",657,0)
 q
"RTN","SAMIHOM4",658,0)
 ;
"RTN","SAMIHOM4",659,0)
UCASE(STR) ; extrinsic returns uppercase of STR
"RTN","SAMIHOM4",660,0)
 N X,Y
"RTN","SAMIHOM4",661,0)
 S X=STR
"RTN","SAMIHOM4",662,0)
 X ^%ZOSF("UPPERCASE")
"RTN","SAMIHOM4",663,0)
 q Y
"RTN","SAMIHOM4",664,0)
 ;
"RTN","SAMIHOM4",665,0)
DEVHOME ; temporary home page for development
"RTN","SAMIHOM4",666,0)
 ; DEVHOME^SAMIHOM3(SAMIRTN,SAMIFILTER) goto DEVHOME^SAMIHOM4
"RTN","SAMIHOM4",667,0)
 ;
"RTN","SAMIHOM4",668,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMIHOM4",669,0)
 ;
"RTN","SAMIHOM4",670,0)
 ;ven/gpl;private;procedure;
"RTN","SAMIHOM4",671,0)
 ;@called-by
"RTN","SAMIHOM4",672,0)
 ; WSHOME
"RTN","SAMIHOM4",673,0)
 ;@calls
"RTN","SAMIHOM4",674,0)
 ; htmltb2^%yottaweb
"RTN","SAMIHOM4",675,0)
 ; PATLIST
"RTN","SAMIHOM4",676,0)
 ; genhtml^%yottautl
"RTN","SAMIHOM4",677,0)
 ; addary^%yottautl
"RTN","SAMIHOM4",678,0)
 ;@input
"RTN","SAMIHOM4",679,0)
 ; SAMIFILTER =
"RTN","SAMIHOM4",680,0)
 ;@output
"RTN","SAMIHOM4",681,0)
 ;.SAMIRTN =
"RTN","SAMIHOM4",682,0)
 ;@examples [tbd]
"RTN","SAMIHOM4",683,0)
 ;@tests [tbd]
"RTN","SAMIHOM4",684,0)
 ;
"RTN","SAMIHOM4",685,0)
 ;@stanza 2 ?
"RTN","SAMIHOM4",686,0)
 ;
"RTN","SAMIHOM4",687,0)
 new gtop,gbot
"RTN","SAMIHOM4",688,0)
 do htmltb2^%yottaweb(.gtop,.gbot,"SAMI Test Patients")
"RTN","SAMIHOM4",689,0)
 ;
"RTN","SAMIHOM4",690,0)
 new html,ary,hpat
"RTN","SAMIHOM4",691,0)
 do PATLIST^SAMIHOM3("hpat")
"RTN","SAMIHOM4",692,0)
 quit:'$data(hpat)
"RTN","SAMIHOM4",693,0)
 ;
"RTN","SAMIHOM4",694,0)
 set ary("title")="SAMI Test Patients on this system"
"RTN","SAMIHOM4",695,0)
 set ary("header",1)="StudyId"
"RTN","SAMIHOM4",696,0)
 set ary("header",2)="Name"
"RTN","SAMIHOM4",697,0)
 ;
"RTN","SAMIHOM4",698,0)
 new cnt set cnt=0
"RTN","SAMIHOM4",699,0)
 new zi set zi=""
"RTN","SAMIHOM4",700,0)
 for  set zi=$order(hpat(zi)) quit:zi=""  do  ;
"RTN","SAMIHOM4",701,0)
 . set cnt=cnt+1
"RTN","SAMIHOM4",702,0)
 . new url set url="<a href=""/cform.cgi?studyId="_zi_""">"_zi_"</a>"
"RTN","SAMIHOM4",703,0)
 . set ary(cnt,1)=url
"RTN","SAMIHOM4",704,0)
 . set ary(cnt,2)=""
"RTN","SAMIHOM4",705,0)
 . quit
"RTN","SAMIHOM4",706,0)
 ;
"RTN","SAMIHOM4",707,0)
 do genhtml^%yottautl("html","ary")
"RTN","SAMIHOM4",708,0)
 ;
"RTN","SAMIHOM4",709,0)
 do addary^%yottautl("SAMIRTN","gtop")
"RTN","SAMIHOM4",710,0)
 do addary^%yottautl("SAMIRTN","html")
"RTN","SAMIHOM4",711,0)
 set SAMIRTN($order(SAMIRTN(""),-1)+1)=gbot
"RTN","SAMIHOM4",712,0)
 kill SAMIRTN(0)
"RTN","SAMIHOM4",713,0)
 ;
"RTN","SAMIHOM4",714,0)
 set HTTPRSP("mime")="text/html"
"RTN","SAMIHOM4",715,0)
 ;
"RTN","SAMIHOM4",716,0)
 ;@stanza ? termination
"RTN","SAMIHOM4",717,0)
 ;
"RTN","SAMIHOM4",718,0)
 quit  ; end of DEVHOME
"RTN","SAMIHOM4",719,0)
 ;
"RTN","SAMIHOM4",720,0)
 ;
"RTN","SAMIHOM4",721,0)
GETHOME ; homepage accessed using GET
"RTN","SAMIHOM4",722,0)
 ; GETHOME^SAMIHOM3(SAMIRTN,SAMIFILTER) goto GETHOME^SAMIHOM4
"RTN","SAMIHOM4",723,0)
 ;
"RTN","SAMIHOM4",724,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMIHOM4",725,0)
 ;
"RTN","SAMIHOM4",726,0)
 ;ven/gpl;private;procedure;
"RTN","SAMIHOM4",727,0)
 ;@called-by
"RTN","SAMIHOM4",728,0)
 ; WSHOME
"RTN","SAMIHOM4",729,0)
 ; WSNEWCAS
"RTN","SAMIHOM4",730,0)
 ; WSNFPOST^SAMICASE
"RTN","SAMIHOM4",731,0)
 ; wsLookup^SAMISRCH
"RTN","SAMIHOM4",732,0)
 ;@calls
"RTN","SAMIHOM4",733,0)
 ; GETTMPL^SAMICASE
"RTN","SAMIHOM4",734,0)
 ; findReplace^%ts
"RTN","SAMIHOM4",735,0)
 ; $$SCANFOR
"RTN","SAMIHOM4",736,0)
 ; ADDCRLF^VPRJRUT
"RTN","SAMIHOM4",737,0)
 ;@input
"RTN","SAMIHOM4",738,0)
 ; SAMIFILTER =
"RTN","SAMIHOM4",739,0)
 ;@output
"RTN","SAMIHOM4",740,0)
 ;.SAMIRTN =
"RTN","SAMIHOM4",741,0)
 ;@examples [tbd]
"RTN","SAMIHOM4",742,0)
 ;@tests [tbd]
"RTN","SAMIHOM4",743,0)
 ;
"RTN","SAMIHOM4",744,0)
 ;@stanza 2 get template for homepage
"RTN","SAMIHOM4",745,0)
 ;
"RTN","SAMIHOM4",746,0)
 ; Processing for multi-tenancy
"RTN","SAMIHOM4",747,0)
 ;
"RTN","SAMIHOM4",748,0)
 if $G(SAMIFILTER("siteid"))="" if '$$FINDSITE^SAMISITE(.SAMIRTN,.SAMIFILTER) Q 0
"RTN","SAMIHOM4",749,0)
 new SAMISITE,SAMITITL
"RTN","SAMIHOM4",750,0)
 s SAMISITE=$G(SAMIFILTER("siteid"))
"RTN","SAMIHOM4",751,0)
 s SAMITITL=$G(SAMIFILTER("sitetitle"))
"RTN","SAMIHOM4",752,0)
 ;
"RTN","SAMIHOM4",753,0)
 new temp,tout,form
"RTN","SAMIHOM4",754,0)
 s form="vapals:home"
"RTN","SAMIHOM4",755,0)
 do GETTMPL^SAMICASE("temp",form)
"RTN","SAMIHOM4",756,0)
 quit:'$data(temp)
"RTN","SAMIHOM4",757,0)
 ;
"RTN","SAMIHOM4",758,0)
 ;@stanza 3 process homepage template
"RTN","SAMIHOM4",759,0)
 ;
"RTN","SAMIHOM4",760,0)
 n err
"RTN","SAMIHOM4",761,0)
 do MERGEHTM^%wf(.temp,.SAMIFILTER,.err)
"RTN","SAMIHOM4",762,0)
 ;
"RTN","SAMIHOM4",763,0)
 ;
"RTN","SAMIHOM4",764,0)
 do ADDCRLF^VPRJRUT(.temp)
"RTN","SAMIHOM4",765,0)
 merge SAMIRTN=temp
"RTN","SAMIHOM4",766,0)
 ;
"RTN","SAMIHOM4",767,0)
 q
"RTN","SAMIHOM4",768,0)
 ;
"RTN","SAMIHOM4",769,0)
 ; below is redacted
"RTN","SAMIHOM4",770,0)
 new cnt set cnt=0
"RTN","SAMIHOM4",771,0)
 new zi set zi=0
"RTN","SAMIHOM4",772,0)
 for  set zi=$order(temp(zi)) quit:+zi=0  do  ;
"RTN","SAMIHOM4",773,0)
 . ;
"RTN","SAMIHOM4",774,0)
 . n ln s ln=temp(zi)
"RTN","SAMIHOM4",775,0)
 . n touched s touched=0
"RTN","SAMIHOM4",776,0)
 . ;
"RTN","SAMIHOM4",777,0)
 . i ln["href" i 'touched d  ;
"RTN","SAMIHOM4",778,0)
 . . d FIXHREF^SAMIFORM(.ln)
"RTN","SAMIHOM4",779,0)
 . . s temp(zi)=ln
"RTN","SAMIHOM4",780,0)
 . ;
"RTN","SAMIHOM4",781,0)
 . i ln["src" d  ;
"RTN","SAMIHOM4",782,0)
 . . d FIXSRC^SAMIFORM(.ln)
"RTN","SAMIHOM4",783,0)
 . . s temp(zi)=ln
"RTN","SAMIHOM4",784,0)
 . ;
"RTN","SAMIHOM4",785,0)
 . i ln["id" i ln["studyIdMenu" d  ;
"RTN","SAMIHOM4",786,0)
 . . s zi=zi+4
"RTN","SAMIHOM4",787,0)
 . ;
"RTN","SAMIHOM4",788,0)
 . if ln["@@MANUALREGISTRATION@@" do  ; turn off manual registration
"RTN","SAMIHOM4",789,0)
 . . n setman,setparm
"RTN","SAMIHOM4",790,0)
 . . s setman="true"
"RTN","SAMIHOM4",791,0)
 . . s setparm=$$GET^XPAR("SYS","SAMI ALLOW MANUAL ENTRY",,"Q")
"RTN","SAMIHOM4",792,0)
 . . i setparm=0 s setman="false"
"RTN","SAMIHOM4",793,0)
 . . do findReplace^%ts(.ln,"@@MANUALREGISTRATION@@",setman)
"RTN","SAMIHOM4",794,0)
 . . s temp(zi)=ln
"RTN","SAMIHOM4",795,0)
 . . quit 
"RTN","SAMIHOM4",796,0)
 . set cnt=cnt+1
"RTN","SAMIHOM4",797,0)
 . set tout(cnt)=temp(zi)
"RTN","SAMIHOM4",798,0)
 . quit
"RTN","SAMIHOM4",799,0)
 ;
"RTN","SAMIHOM4",800,0)
 ;@stanza 4 add cr/lf & save to return array
"RTN","SAMIHOM4",801,0)
 ;
"RTN","SAMIHOM4",802,0)
 do ADDCRLF^VPRJRUT(.tout)
"RTN","SAMIHOM4",803,0)
 merge SAMIRTN=tout
"RTN","SAMIHOM4",804,0)
 ;
"RTN","SAMIHOM4",805,0)
 ;@stanza 5 termination
"RTN","SAMIHOM4",806,0)
 ;
"RTN","SAMIHOM4",807,0)
 quit  ; end of GETHOME
"RTN","SAMIHOM4",808,0)
 ;
"RTN","SAMIHOM4",809,0)
 ;
"RTN","SAMIHOM4",810,0)
WSNEWCAS ; receives post from home & creates new case
"RTN","SAMIHOM4",811,0)
 ; WSNEWCAS^SAMIHOM3(SAMIARGS,SAMIBODY,SAMIRESULT) goto WSNEWCAS^SAMIHOM4
"RTN","SAMIHOM4",812,0)
 ;
"RTN","SAMIHOM4",813,0)
 ;@stanza 1 invocation, binding, & branching
"RTN","SAMIHOM4",814,0)
 ;
"RTN","SAMIHOM4",815,0)
 ;ven/gpl;private;procedure;
"RTN","SAMIHOM4",816,0)
 ;@called-by
"RTN","SAMIHOM4",817,0)
 ;@calls
"RTN","SAMIHOM4",818,0)
 ; parseBody^%wf
"RTN","SAMIHOM4",819,0)
 ; $$setroot^%wd
"RTN","SAMIHOM4",820,0)
 ; $$NEXTNUM
"RTN","SAMIHOM4",821,0)
 ; $$GENSTDID^SAMIHOM3
"RTN","SAMIHOM4",822,0)
 ; $$NOW^XLFDT
"RTN","SAMIHOM4",823,0)
 ; $$KEYDATE^SAMIHOM3
"RTN","SAMIHOM4",824,0)
 ; $$VALDTNM
"RTN","SAMIHOM4",825,0)
 ; GETHOME
"RTN","SAMIHOM4",826,0)
 ; PREFILL
"RTN","SAMIHOM4",827,0)
 ; MKSBFORM
"RTN","SAMIHOM4",828,0)
 ; MKSIFORM^SAMIHOM3
"RTN","SAMIHOM4",829,0)
 ; WSCASE^SAMICASE
"RTN","SAMIHOM4",830,0)
 ;@input
"RTN","SAMIHOM4",831,0)
 ;.ARGS =
"RTN","SAMIHOM4",832,0)
 ; BODY =
"RTN","SAMIHOM4",833,0)
 ;.RESULT =
"RTN","SAMIHOM4",834,0)
 ;@output: ?
"RTN","SAMIHOM4",835,0)
 ;@examples [tbd]
"RTN","SAMIHOM4",836,0)
 ;@tests [tbd]
"RTN","SAMIHOM4",837,0)
 ;
"RTN","SAMIHOM4",838,0)
 ;@stanza 2 ?
"RTN","SAMIHOM4",839,0)
 ;
"RTN","SAMIHOM4",840,0)
 merge ^SAMIUL("newCase","ARGS")=SAMIARGS
"RTN","SAMIHOM4",841,0)
 merge ^SAMIUL("newCase","BODY")=SAMIBODY
"RTN","SAMIHOM4",842,0)
 ;
"RTN","SAMIHOM4",843,0)
 new vars,bdy
"RTN","SAMIHOM4",844,0)
 set SAMIBDY=$get(SAMIBODY(1))
"RTN","SAMIHOM4",845,0)
 do parseBody^%wf("vars",.SAMIBDY)
"RTN","SAMIHOM4",846,0)
 merge ^SAMIUL("newCase","vars")=vars
"RTN","SAMIHOM4",847,0)
 ;
"RTN","SAMIHOM4",848,0)
 new root set root=$$setroot^%wd("vapals-patients")
"RTN","SAMIHOM4",849,0)
 ;
"RTN","SAMIHOM4",850,0)
 new saminame set saminame=$get(vars("name"))
"RTN","SAMIHOM4",851,0)
 if saminame="" s saminame=$get(vars("saminame"))
"RTN","SAMIHOM4",852,0)
 ;if $$VALDTNM(saminame,.ARGS)=-1 do  quit  ;
"RTN","SAMIHOM4",853,0)
 ;. new r1
"RTN","SAMIHOM4",854,0)
 ;. do GETHOME(.r1,.ARGS) ; home page to redisplay
"RTN","SAMIHOM4",855,0)
 ;. merge RESULT=r1
"RTN","SAMIHOM4",856,0)
 ;. quit
"RTN","SAMIHOM4",857,0)
 ;
"RTN","SAMIHOM4",858,0)
 new dfn s dfn=$get(vars("dfn"))
"RTN","SAMIHOM4",859,0)
 ;if dfn="" do  quit  ;
"RTN","SAMIHOM4",860,0)
 ;. new r1
"RTN","SAMIHOM4",861,0)
 ;. do GETHOME(.r1,.ARGS) ; home page to redisplay
"RTN","SAMIHOM4",862,0)
 ;. merge RESULT=r1
"RTN","SAMIHOM4",863,0)
 ;. quit
"RTN","SAMIHOM4",864,0)
 ;
"RTN","SAMIHOM4",865,0)
 ;new gien set gien=$$NEXTNUM
"RTN","SAMIHOM4",866,0)
 new gien set gien=dfn
"RTN","SAMIHOM4",867,0)
 ;
"RTN","SAMIHOM4",868,0)
 m ^SAMIUL("newCase","G1")=root
"RTN","SAMIHOM4",869,0)
 ; create dfn index
"RTN","SAMIHOM4",870,0)
 set @root@("dfn",dfn,gien)=""
"RTN","SAMIHOM4",871,0)
 ;
"RTN","SAMIHOM4",872,0)
 set @root@(gien,"saminum")=gien
"RTN","SAMIHOM4",873,0)
 set @root@(gien,"saminame")=saminame
"RTN","SAMIHOM4",874,0)
 ;
"RTN","SAMIHOM4",875,0)
 new studyid set studyid=$$GENSTDID^SAMIHOM3(gien,.SAMIARGS)
"RTN","SAMIHOM4",876,0)
 set @root@(gien,"samistudyid")=studyid
"RTN","SAMIHOM4",877,0)
 set @root@("sid",studyid,gien)=""
"RTN","SAMIHOM4",878,0)
 ;
"RTN","SAMIHOM4",879,0)
 new datekey set datekey=$$KEYDATE^SAMIHOM3($$NOW^XLFDT)
"RTN","SAMIHOM4",880,0)
 set @root@(gien,"samicreatedate")=datekey
"RTN","SAMIHOM4",881,0)
 ;
"RTN","SAMIHOM4",882,0)
 merge ^SAMIUL("newCase",gien)=@root@(gien)
"RTN","SAMIHOM4",883,0)
 ;
"RTN","SAMIHOM4",884,0)
 ;
"RTN","SAMIHOM4",885,0)
 do PREFILL^SAMIHOM3(dfn) ; prefills from the "patient-lookup" graph
"RTN","SAMIHOM4",886,0)
 ;
"RTN","SAMIHOM4",887,0)
 n siformkey
"RTN","SAMIHOM4",888,0)
 ;do makeSbform(gien) ; create a background form for new patient
"RTN","SAMIHOM4",889,0)
 set siformkey=$$MKSIFORM^SAMIHOM3(gien) ; create an intake for for new patient
"RTN","SAMIHOM4",890,0)
 ;
"RTN","SAMIHOM4",891,0)
 set SAMIARGS("studyid")=studyid
"RTN","SAMIHOM4",892,0)
 set SAMIARGS("form")="vapals:"_siformkey
"RTN","SAMIHOM4",893,0)
 do wsGetForm^%wf(.SAMIRESULT,.SAMIARGS)
"RTN","SAMIHOM4",894,0)
 ;do WSCASE^SAMICASE(.SAMIRESULT,.SAMIARGS) ; navigate to the case review page
"RTN","SAMIHOM4",895,0)
 ;
"RTN","SAMIHOM4",896,0)
 ;@stanza ? termination
"RTN","SAMIHOM4",897,0)
 ;
"RTN","SAMIHOM4",898,0)
 quit  ; end of WSNEWCAS
"RTN","SAMIHOM4",899,0)
 ;
"RTN","SAMIHOM4",900,0)
 ;
"RTN","SAMIHOM4",901,0)
EOR ; End of routine SAMIHOM4
"RTN","SAMINOT1")
0^2^B311363583
"RTN","SAMINOT1",1,0)
SAMINOT1 ;ven/gpl - ielcap: forms ; 5/7/19 4:48pm
"RTN","SAMINOT1",2,0)
 ;;18.0;SAMI;;;Build 1
"RTN","SAMINOT1",3,0)
 ;
"RTN","SAMINOT1",4,0)
 ;@license: see routine SAMIUL
"RTN","SAMINOT1",5,0)
 ;
"RTN","SAMINOT1",6,0)
 quit  ; no entry from top
"RTN","SAMINOT1",7,0)
 ;
"RTN","SAMINOT1",8,0)
EXISTCE(SID,FORM) ; extrinsic returns "true" or "false"
"RTN","SAMINOT1",9,0)
 ; if a Chart Eligibility Note exists
"RTN","SAMINOT1",10,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMINOT1",11,0)
 n gvals s gvals=$na(@root@("graph",SID,FORM))
"RTN","SAMINOT1",12,0)
 ;i $g(@root@("graph",SID,FORM,"sicechrt"))="y" q "true"
"RTN","SAMINOT1",13,0)
 i $g(@gvals@("pre-note-complete"))="true" q "true"
"RTN","SAMINOT1",14,0)
 q "false"
"RTN","SAMINOT1",15,0)
 ;
"RTN","SAMINOT1",16,0)
EXISTPRE(SID,FORM) ; extrinsic returns "true" or "false"
"RTN","SAMINOT1",17,0)
 ; if a Pre-enrollment Note exists
"RTN","SAMINOT1",18,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMINOT1",19,0)
 n gvals s gvals=$na(@root@("graph",SID,FORM))
"RTN","SAMINOT1",20,0)
 ;i $g(@root@("graph",SID,FORM,"sipedisc"))="y" q "true"
"RTN","SAMINOT1",21,0)
 i $g(@gvals@("pre-note-complete"))="true" i $g(@gvals@("siperslt"))="y" q "true"
"RTN","SAMINOT1",22,0)
 q "false"
"RTN","SAMINOT1",23,0)
 ;
"RTN","SAMINOT1",24,0)
EXISTINT(SID,FORM) ; extrinsic returns "true" or "false"
"RTN","SAMINOT1",25,0)
 ; if an Intake Note exists
"RTN","SAMINOT1",26,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMINOT1",27,0)
 i $g(@root@("graph",SID,FORM,"sistatus"))="y" q "true"
"RTN","SAMINOT1",28,0)
 q "false"
"RTN","SAMINOT1",29,0)
 ;
"RTN","SAMINOT1",30,0)
WSNOTE(return,filter) ; web service which returns a text note
"RTN","SAMINOT1",31,0)
 ;
"RTN","SAMINOT1",32,0)
 n debug s debug=0
"RTN","SAMINOT1",33,0)
 i $g(filter("debug"))=1 s debug=1
"RTN","SAMINOT1",34,0)
 ;
"RTN","SAMINOT1",35,0)
 k return
"RTN","SAMINOT1",36,0)
 s HTTPRSP("mime")="text/html"
"RTN","SAMINOT1",37,0)
 ;
"RTN","SAMINOT1",38,0)
 n si
"RTN","SAMINOT1",39,0)
 s si=$g(filter("studyid"))
"RTN","SAMINOT1",40,0)
 i si="" d  ;
"RTN","SAMINOT1",41,0)
 . s si="XXX00333"
"RTN","SAMINOT1",42,0)
 q:si=""
"RTN","SAMINOT1",43,0)
 ;
"RTN","SAMINOT1",44,0)
 n samikey
"RTN","SAMINOT1",45,0)
 s samikey=$g(filter("form"))
"RTN","SAMINOT1",46,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMINOT1",47,0)
 i samikey="" d  ;
"RTN","SAMINOT1",48,0)
 . s samikey=$o(@root@("graph",si,"siform"))
"RTN","SAMINOT1",49,0)
 . ;w !,samikey
"RTN","SAMINOT1",50,0)
 . ;b
"RTN","SAMINOT1",51,0)
 ;
"RTN","SAMINOT1",52,0)
 n vals
"RTN","SAMINOT1",53,0)
 m vals=@root@("graph",si,samikey)
"RTN","SAMINOT1",54,0)
 ;
"RTN","SAMINOT1",55,0)
 n note,nien,ntype
"RTN","SAMINOT1",56,0)
 s ntype=""
"RTN","SAMINOT1",57,0)
 s note=""
"RTN","SAMINOT1",58,0)
 s nien=$g(filter("nien"))
"RTN","SAMINOT1",59,0)
 i nien="" d
"RTN","SAMINOT1",60,0)
 . s:$g(vals("samistatus"))="complete" ntype="intake"
"RTN","SAMINOT1",61,0)
 . s:$g(vals("samistatus"))="chart-eligibility" ntype="eligibility"
"RTN","SAMINOT1",62,0)
 . s:$g(vals("samistatus"))="pre-enrollment-discussion" ntype="pre-note"
"RTN","SAMINOT1",63,0)
 . q:ntype=""
"RTN","SAMINOT1",64,0)
 . ;d nien=$$NTTYPE add code to pull the latest note by type
"RTN","SAMINOT1",65,0)
 q:nien=""
"RTN","SAMINOT1",66,0)
 n notebase
"RTN","SAMINOT1",67,0)
 s notebase=$$NTLOCN(si,samikey,nien) ; global location for the note
"RTN","SAMINOT1",68,0)
 s note=$na(@notebase@("text"))
"RTN","SAMINOT1",69,0)
 i '$d(@note) q
"RTN","SAMINOT1",70,0)
 ;
"RTN","SAMINOT1",71,0)
 new temp,tout
"RTN","SAMINOT1",72,0)
 do GETTMPL^SAMICASE("temp","vapals:note")
"RTN","SAMINOT1",73,0)
 quit:'$data(temp)
"RTN","SAMINOT1",74,0)
 ;
"RTN","SAMINOT1",75,0)
 n cnt s cnt=0
"RTN","SAMINOT1",76,0)
 n zi s zi=""
"RTN","SAMINOT1",77,0)
 ;
"RTN","SAMINOT1",78,0)
 f  s zi=$o(temp(zi)) q:zi=""  d  ;
"RTN","SAMINOT1",79,0)
 . ;
"RTN","SAMINOT1",80,0)
 . n line s line=temp(zi)
"RTN","SAMINOT1",81,0)
 . D LOAD^SAMIFORM(.line,samikey,si,.filter,.vals)
"RTN","SAMINOT1",82,0)
 . s temp(zi)=line
"RTN","SAMINOT1",83,0)
 . ;
"RTN","SAMINOT1",84,0)
 . s cnt=cnt+1
"RTN","SAMINOT1",85,0)
 . s tout(cnt)=temp(zi)
"RTN","SAMINOT1",86,0)
 . ;
"RTN","SAMINOT1",87,0)
 . i temp(zi)["report-text" d  ;
"RTN","SAMINOT1",88,0)
 . . i temp(zi)["#" q  ;
"RTN","SAMINOT1",89,0)
 . . n zj s zj=""
"RTN","SAMINOT1",90,0)
 . . f  s zj=$o(@note@(zj)) q:zj=""  d  ;
"RTN","SAMINOT1",91,0)
 . . . s cnt=cnt+1
"RTN","SAMINOT1",92,0)
 . . . ;s tout(cnt)=@note@(zj)_"<br>"
"RTN","SAMINOT1",93,0)
 . . . s tout(cnt)=@note@(zj)_$char(13,10)
"RTN","SAMINOT1",94,0)
 m return=tout
"RTN","SAMINOT1",95,0)
 q
"RTN","SAMINOT1",96,0)
 ;
"RTN","SAMINOT1",97,0)
NOTE(filter) ; extrnisic which creates a note
"RTN","SAMINOT1",98,0)
 ; returns 1 if successful, 0 if not
"RTN","SAMINOT1",99,0)
 ;
"RTN","SAMINOT1",100,0)
 ;
"RTN","SAMINOT1",101,0)
 ;
"RTN","SAMINOT1",102,0)
 ; set up patient values
"RTN","SAMINOT1",103,0)
 ;
"RTN","SAMINOT1",104,0)
 n vals
"RTN","SAMINOT1",105,0)
 ;
"RTN","SAMINOT1",106,0)
 n si
"RTN","SAMINOT1",107,0)
 s si=$g(filter("studyid"))
"RTN","SAMINOT1",108,0)
 i si="" d  ;
"RTN","SAMINOT1",109,0)
 . s si="XXX00333"
"RTN","SAMINOT1",110,0)
 q:si=""
"RTN","SAMINOT1",111,0)
 ;
"RTN","SAMINOT1",112,0)
 n samikey
"RTN","SAMINOT1",113,0)
 s samikey=$g(filter("form"))
"RTN","SAMINOT1",114,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMINOT1",115,0)
 i samikey="" d  ;
"RTN","SAMINOT1",116,0)
 . s samikey=$o(@root@("graph",si,"siform"))
"RTN","SAMINOT1",117,0)
 . ;w !,samikey
"RTN","SAMINOT1",118,0)
 . ;b
"RTN","SAMINOT1",119,0)
 ;
"RTN","SAMINOT1",120,0)
 s vals=$na(@root@("graph",si,samikey))
"RTN","SAMINOT1",121,0)
 ;
"RTN","SAMINOT1",122,0)
 i '$d(@vals) d  q 0 ;
"RTN","SAMINOT1",123,0)
 . ;w !,"error, patient values not found"
"RTN","SAMINOT1",124,0)
 ;zwr @vals@(*)
"RTN","SAMINOT1",125,0)
 ;
"RTN","SAMINOT1",126,0)
 k ^SAMIUL("NOTE")
"RTN","SAMINOT1",127,0)
 m ^SAMIUL("NOTE","vals")=@vals
"RTN","SAMINOT1",128,0)
 m ^SAMIUL("NOTE","filter")=filter
"RTN","SAMINOT1",129,0)
 ;
"RTN","SAMINOT1",130,0)
 n didnote s didnote=0
"RTN","SAMINOT1",131,0)
 ;
"RTN","SAMINOT1",132,0)
 i $g(@vals@("samistatus"))="chart-eligibility" d  ;
"RTN","SAMINOT1",133,0)
 . d MKEL(si,samikey,vals,.filter) ;
"RTN","SAMINOT1",134,0)
 . s didnote=1
"RTN","SAMINOT1",135,0)
 ;
"RTN","SAMINOT1",136,0)
 i $g(@vals@("samistatus"))="pre-enrollment-discussion" d  ;
"RTN","SAMINOT1",137,0)
 . d MKPRE(si,samikey,vals,.filter) ;
"RTN","SAMINOT1",138,0)
 . s didnote=1
"RTN","SAMINOT1",139,0)
 ;
"RTN","SAMINOT1",140,0)
 i $g(@vals@("samistatus"))="complete" d  ;
"RTN","SAMINOT1",141,0)
 . q:$$HASINNT(vals)
"RTN","SAMINOT1",142,0)
 . d MKIN(si,samikey,vals,.filter) ;
"RTN","SAMINOT1",143,0)
 . s didnote=1
"RTN","SAMINOT1",144,0)
 ;
"RTN","SAMINOT1",145,0)
 q didnote
"RTN","SAMINOT1",146,0)
 ;
"RTN","SAMINOT1",147,0)
HASINNT(vals) ; extrinsic returns 1 if intake note is present
"RTN","SAMINOT1",148,0)
 ; else returns 0
"RTN","SAMINOT1",149,0)
 n zzi,zzrtn s (zzi,zzrtn)=0
"RTN","SAMINOT1",150,0)
 q:'$d(@vals)
"RTN","SAMINOT1",151,0)
 f  s zzi=$o(@vals@("notes",zzi)) q:+zzi=0  d  ;
"RTN","SAMINOT1",152,0)
 . i $g(@vals@("notes",zzi,"name"))["Intake" s zzrtn=1
"RTN","SAMINOT1",153,0)
 q zzrtn
"RTN","SAMINOT1",154,0)
 ;
"RTN","SAMINOT1",155,0)
MKEL(sid,form,vals,filter) ;
"RTN","SAMINOT1",156,0)
 n cnt s cnt=0
"RTN","SAMINOT1",157,0)
 ;n dest s dest=$na(@vals@("eligibility-note"))
"RTN","SAMINOT1",158,0)
 n dest s dest=$$MKNT(vals,"Eligibility Note","eligibility",.filter)
"RTN","SAMINOT1",159,0)
 k @dest
"RTN","SAMINOT1",160,0)
 d OUT("Lung Screening Program Chart Eligibility Note")
"RTN","SAMINOT1",161,0)
 d OUT("")
"RTN","SAMINOT1",162,0)
 d ELNOTE(vals,dest,cnt)
"RTN","SAMINOT1",163,0)
 q
"RTN","SAMINOT1",164,0)
 ;
"RTN","SAMINOT1",165,0)
MKPRE(sid,form,vals,filter) ;
"RTN","SAMINOT1",166,0)
 n cnt s cnt=0
"RTN","SAMINOT1",167,0)
 ;n dest s dest=$na(@vals@("pre-note"))
"RTN","SAMINOT1",168,0)
 n dest s dest=$$MKNT(vals,"Pre-enrollment Discussion Note","prenote",.filter)
"RTN","SAMINOT1",169,0)
 k @dest
"RTN","SAMINOT1",170,0)
 i $g(@vals@("chart-eligibility-complete"))'="true" d  ;
"RTN","SAMINOT1",171,0)
 . d OUT("Lung Screening Program Chart Eligibility and Pre-enrollment Discussion Note")
"RTN","SAMINOT1",172,0)
 . d OUT("")
"RTN","SAMINOT1",173,0)
 . d ELNOTE(vals,dest,cnt)
"RTN","SAMINOT1",174,0)
 i $g(@vals@("chart-eligibility-complete"))="true" d  ;
"RTN","SAMINOT1",175,0)
 . d OUT("Lung Screening Program Pre-enrollment Discussion Note")
"RTN","SAMINOT1",176,0)
 . d OUT("")
"RTN","SAMINOT1",177,0)
 d PRENOTE(vals,dest,cnt)
"RTN","SAMINOT1",178,0)
 q
"RTN","SAMINOT1",179,0)
 ;
"RTN","SAMINOT1",180,0)
MKIN(sid,form,vals,filter) ;
"RTN","SAMINOT1",181,0)
 n cnt s cnt=0
"RTN","SAMINOT1",182,0)
 ;n dest s dest=$na(@vals@("intake-note"))
"RTN","SAMINOT1",183,0)
 n dest s dest=$$MKNT(vals,"Intake Note","intake",.filter)
"RTN","SAMINOT1",184,0)
 k @dest
"RTN","SAMINOT1",185,0)
 d OUT("Lung Screening Program Intake Note")
"RTN","SAMINOT1",186,0)
 d OUT("")
"RTN","SAMINOT1",187,0)
 i $g(@vals@("chart-eligibility-complete"))'="true" d  ;
"RTN","SAMINOT1",188,0)
 . d ELNOTE(vals,dest,cnt)
"RTN","SAMINOT1",189,0)
 i $g(@vals@("pre-note-complete"))'="true" d  ;
"RTN","SAMINOT1",190,0)
 . d PRENOTE(vals,dest,cnt)
"RTN","SAMINOT1",191,0)
 d INNOTE(vals,dest,cnt)
"RTN","SAMINOT1",192,0)
 q
"RTN","SAMINOT1",193,0)
 ;
"RTN","SAMINOT1",194,0)
MKNT(vals,title,ntype,filter) ; extrinsic makes a note date=now returns 
"RTN","SAMINOT1",195,0)
 ; global addr. filter must be passed by reference
"RTN","SAMINOT1",196,0)
 n ntdt s ntdt=$$NTDTTM($$NOW^XLFDT)
"RTN","SAMINOT1",197,0)
 n ntptr
"RTN","SAMINOT1",198,0)
 s ntptr=$$MKNTLOC(vals,title,ntdt,$g(ntype),.filter)
"RTN","SAMINOT1",199,0)
 q ntptr
"RTN","SAMINOT1",200,0)
 ;
"RTN","SAMINOT1",201,0)
MKNTLOC(vals,title,ndate,ntype,filter) ; extrinsic returns the 
"RTN","SAMINOT1",202,0)
 ;location for the note
"RTN","SAMINOT1",203,0)
 n nien
"RTN","SAMINOT1",204,0)
 s nien=$o(@vals@("notes",""),-1)+1
"RTN","SAMINOT1",205,0)
 s filter("nien")=nien
"RTN","SAMINOT1",206,0)
 n nloc s nloc=$na(@vals@("notes",nien))
"RTN","SAMINOT1",207,0)
 s @nloc@("name")=title_" "_$g(ndate)
"RTN","SAMINOT1",208,0)
 s @nloc@("date")=$g(ndate)
"RTN","SAMINOT1",209,0)
 s @nloc@("type")=$g(ntype)
"RTN","SAMINOT1",210,0)
 q $na(@nloc@("text"))
"RTN","SAMINOT1",211,0)
 ;
"RTN","SAMINOT1",212,0)
NTDTTM(ZFMDT) ; extrinsic returns the date and time in Note format
"RTN","SAMINOT1",213,0)
 ; ZFMDT is the fileman date/time to translate
"RTN","SAMINOT1",214,0)
 q $$FMTE^XLFDT(ZFMDT,"5")
"RTN","SAMINOT1",215,0)
 ;
"RTN","SAMINOT1",216,0)
NTLOCN(sid,form,nien) ; extrinsic returns the location of the Nth note
"RTN","SAMINOT1",217,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMINOT1",218,0)
 q $na(@root@("graph",sid,form,"notes",nien))
"RTN","SAMINOT1",219,0)
 ;
"RTN","SAMINOT1",220,0)
NTLAST(sid,form,ntype) ; extrinsic returns the location of the latest note
"RTN","SAMINOT1",221,0)
 ; of the type ntype
"RTN","SAMINOT1",222,0)
 q
"RTN","SAMINOT1",223,0)
 ;
"RTN","SAMINOT1",224,0)
NTIEN(sid,form) ; extrinsic which returns the latest note for this form
"RTN","SAMINOT1",225,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMINOT1",226,0)
 n rtn s rtn=$o(@root@("graph",sid,form,"notes"," "),-1)
"RTN","SAMINOT1",227,0)
 q rtn
"RTN","SAMINOT1",228,0)
 ;
"RTN","SAMINOT1",229,0)
NTLIST(nlist,sid,form) ; returns the note list in nlist, passed by ref
"RTN","SAMINOT1",230,0)
 ;
"RTN","SAMINOT1",231,0)
 n zn,root,gn
"RTN","SAMINOT1",232,0)
 s root=$$setroot^%wd("vapals-patients")
"RTN","SAMINOT1",233,0)
 s zn=0
"RTN","SAMINOT1",234,0)
 s gn=$na(@root@("graph",sid,form,"notes"))
"RTN","SAMINOT1",235,0)
 q:'$d(@gn)
"RTN","SAMINOT1",236,0)
 f  s zn=$o(@gn@(zn)) q:+zn=0  d  ;
"RTN","SAMINOT1",237,0)
 . s @nlist@(zn,"name")=@gn@(zn,"name")
"RTN","SAMINOT1",238,0)
 . s @nlist@(zn,"nien")=zn
"RTN","SAMINOT1",239,0)
 ;
"RTN","SAMINOT1",240,0)
 q
"RTN","SAMINOT1",241,0)
 ;
"RTN","SAMINOT1",242,0)
TLST ;
"RTN","SAMINOT1",243,0)
 S SID="XXX00677"
"RTN","SAMINOT1",244,0)
 S FORM="siform-2019-04-23"
"RTN","SAMINOT1",245,0)
 D NTLIST("G",SID,FORM)
"RTN","SAMINOT1",246,0)
 ;ZWR G
"RTN","SAMINOT1",247,0)
 Q
"RTN","SAMINOT1",248,0)
 ;
"RTN","SAMINOT1",249,0)
ELNOTE(vals,dest,cnt) ; eligibility NOTE TEXT
"RTN","SAMINOT1",250,0)
 D OUT("")
"RTN","SAMINOT1",251,0)
 D OUT("Date of chart review: "_$$XVAL("sidc",vals))
"RTN","SAMINOT1",252,0)
 D OUT("The participant was identified as a potential lung screening candidate by: "_$$XVAL("siceiden",vals))
"RTN","SAMINOT1",253,0)
 if $$XVAL("siceiden",vals)="referral" d  ;
"RTN","SAMINOT1",254,0)
 . D OUT("Date of Referral: "_$$XVAL("sicerfdt",vals))
"RTN","SAMINOT1",255,0)
 . n spec s spec=""
"RTN","SAMINOT1",256,0)
 . s:$$XVAL("sicerfpc",vals)="y" spec=spec_" Primary Care"
"RTN","SAMINOT1",257,0)
 . s:$$XVAL("sicerfwh",vals)="y" spec=spec_" Women's Health"
"RTN","SAMINOT1",258,0)
 . s:$$XVAL("sicerfge",vals)="y" spec=spec_" Geriatrics"
"RTN","SAMINOT1",259,0)
 . s:$$XVAL("sicerfpu",vals)="y" spec=spec_" Pulmonology"
"RTN","SAMINOT1",260,0)
 . s:$$XVAL("sicerfon",vals)="y" spec=spec_" Oncology"
"RTN","SAMINOT1",261,0)
 . s:$$XVAL("sicerfsc",vals)="y" spec=spec_" Smoking Cessation"
"RTN","SAMINOT1",262,0)
 . s:$$XVAL("sicerfot",vals)="y" spec=spec_" "_$$XVAL("sicerfoo",vals)
"RTN","SAMINOT1",263,0)
 . D OUT("Specialty of referring provider: "_spec)
"RTN","SAMINOT1",264,0)
 n elig
"RTN","SAMINOT1",265,0)
 s elig=$$XVAL("sicechrt",vals)
"RTN","SAMINOT1",266,0)
 D OUT("The participant is eligible based on chart review: "_$s(elig="y":"Yes",1:"no"))
"RTN","SAMINOT1",267,0)
 D OUT("")
"RTN","SAMINOT1",268,0)
 s @vals@("chart-eligibility-complete")="true"
"RTN","SAMINOT1",269,0)
 q
"RTN","SAMINOT1",270,0)
 ;
"RTN","SAMINOT1",271,0)
PRENOTE(vals,dest,cnt) ;
"RTN","SAMINOT1",272,0)
 ;
"RTN","SAMINOT1",273,0)
 i $g(@vals@("sipedisc"))'="y" q  ; no prelim discussion
"RTN","SAMINOT1",274,0)
 D OUT("")
"RTN","SAMINOT1",275,0)
 ;d OUT("A pre-enrollment discussion was held.")
"RTN","SAMINOT1",276,0)
 ;[If Yes is selected then add the following 5 lines]
"RTN","SAMINOT1",277,0)
 D OUT("The program attempted to reach the Veteran to discuss lung screening.")
"RTN","SAMINOT1",278,0)
 D OUT("Date of pre-enrollment discussion: "_$$XVAL("sipedc",vals))
"RTN","SAMINOT1",279,0)
 n via s via=""
"RTN","SAMINOT1",280,0)
 s:$$XVAL("sipecnip",vals)="1" via=via_" In person"
"RTN","SAMINOT1",281,0)
 s:$$XVAL("sipecnte",vals)="1" via=via_" Telephone"
"RTN","SAMINOT1",282,0)
 s:$$XVAL("sipecnth",vals)="1" via=via_" TeleHealth"
"RTN","SAMINOT1",283,0)
 s:$$XVAL("sipecnml",vals)="1" via=via_" Mailed Letter"
"RTN","SAMINOT1",284,0)
 s:$$XVAL("sipecnpp",vals)="1" via=via_" Message in patient portal"
"RTN","SAMINOT1",285,0)
 s:$$XVAL("sipecnvd",vals)="1" via=via_" Video-on-Demand (VOD)"
"RTN","SAMINOT1",286,0)
 s:$$XVAL("sipecnot",vals)="1" via=via_" "_$$XVAL("sipecnoo",vals)
"RTN","SAMINOT1",287,0)
 D OUT("The lung screening program reached the potential candidate or was contacted via:"_via)
"RTN","SAMINOT1",288,0)
 D OUT("The pre-enrollment discussion with the participant resulted in: "_$$SUBRSLT($$XVAL("siperslt",vals)))
"RTN","SAMINOT1",289,0)
 D OUT("Comments: "_$$XVAL("sipecmnt",vals))
"RTN","SAMINOT1",290,0)
 ;
"RTN","SAMINOT1",291,0)
 s @vals@("pre-note-complete")="true"
"RTN","SAMINOT1",292,0)
 q
"RTN","SAMINOT1",293,0)
 ;
"RTN","SAMINOT1",294,0)
SUBRSLT(XVAL) ; translation of discussion result
"RTN","SAMINOT1",295,0)
 q:XVAL="y" "Participant is interested in discussing lung screening. The program will proceed with enrollment process."
"RTN","SAMINOT1",296,0)
 q:XVAL="u" "Participant is unsure of lung screening. Ok to contact in the future."
"RTN","SAMINOT1",297,0)
 q:XVAL="nn" "Participant is not interested in discussing lung screening at this time. Ok to contact in the future."
"RTN","SAMINOT1",298,0)
 q:XVAL="nf" "Participant is not interested in discussing lung screening in the future."
"RTN","SAMINOT1",299,0)
 q:XVAL="na" "Unable to reach participant at this time"
"RTN","SAMINOT1",300,0)
 q ""
"RTN","SAMINOT1",301,0)
 ;
"RTN","SAMINOT1",302,0)
INNOTE(vals,dest,cnt) ;
"RTN","SAMINOT1",303,0)
 ;
"RTN","SAMINOT1",304,0)
 ;Lung Screening Program Intake Note
"RTN","SAMINOT1",305,0)
 ;
"RTN","SAMINOT1",306,0)
 ;Date of intake discussion contact:       [Date]
"RTN","SAMINOT1",307,0)
 ;How did you learn about the Lung Screening Program?:  [Selection]
"RTN","SAMINOT1",308,0)
 ;Primary address verified:                 [Yes/No]
"RTN","SAMINOT1",309,0)
 ;Rural status:                                        [Urban/Rural/Unknown]
"RTN","SAMINOT1",310,0)
 ;Preferred address and contact number:
"RTN","SAMINOT1",311,0)
 ;     [Address 1]
"RTN","SAMINOT1",312,0)
 ;           [Address 2]
"RTN","SAMINOT1",313,0)
 ;              [Address]
"RTN","SAMINOT1",314,0)
 ;
"RTN","SAMINOT1",315,0)
 ;Ever smoked?:            [Ever Smoked Text]
"RTN","SAMINOT1",316,0)
 ;Smoking Status:          [Never Smoked/Past/Current/Willing to Quit]
"RTN","SAMINOT1",317,0)
 ;CIGs per day:               [Input Number]
"RTN","SAMINOT1",318,0)
 ;PPD:                              [Computed Number]
"RTN","SAMINOT1",319,0)
 ;# of years:                    [Input Number]
"RTN","SAMINOT1",320,0)
 ;Pack Years:                   [Computed Number]
"RTN","SAMINOT1",321,0)
 ;
"RTN","SAMINOT1",322,0)
 ;[If a Quit Date is entered add the following line]
"RTN","SAMINOT1",323,0)
 ;Quit smoking on:         [Date]
"RTN","SAMINOT1",324,0)
 ;
"RTN","SAMINOT1",325,0)
 ;[If Smoking Cessation education text is entered add the following line]
"RTN","SAMINOT1",326,0)
 ;Smoking cessation education provided: [Show Input Text]
"RTN","SAMINOT1",327,0)
 ;
"RTN","SAMINOT1",328,0)
 ;[If a Lung Cancer Dx date is entered show the following 1 to 2 lines]
"RTN","SAMINOT1",329,0)
 ;Prior lung cancer diagnosis date: [Date]
"RTN","SAMINOT1",330,0)
 ;[If a location not in the VA is specified show the next line]
"RTN","SAMINOT1",331,0)
 ;Location where prior lung cancer diagnosis was made: [Location Text]
"RTN","SAMINOT1",332,0)
 ;
"RTN","SAMINOT1",333,0)
 ;[If Any Prior CT Date is entered show the following 1 to 2 lines]
"RTN","SAMINOT1",334,0)
 ;Prior CT:                   [Date]
"RTN","SAMINOT1",335,0)
 ;[If a location not in the VA is specified show the next line]
"RTN","SAMINOT1",336,0)
 ;Location where prior lung cancer diagnosis was made: [Location Text]
"RTN","SAMINOT1",337,0)
 ;
"RTN","SAMINOT1",338,0)
 ;Shared Decision Making:
"RTN","SAMINOT1",339,0)
 ;
"RTN","SAMINOT1",340,0)
 d OUT(" ")
"RTN","SAMINOT1",341,0)
 d OUT("   "_"Date of intake discussion contact: "_$$XVAL("sidc",vals))
"RTN","SAMINOT1",342,0)
 n learn s learn=""
"RTN","SAMINOT1",343,0)
 s:$$XVAL("silnip",vals) learn=learn_" In person"
"RTN","SAMINOT1",344,0)
 s:$$XVAL("silnph",vals) learn=learn_" Telephone"
"RTN","SAMINOT1",345,0)
 s:$$XVAL("silnth",vals) learn=learn_" TeleHealth"
"RTN","SAMINOT1",346,0)
 s:$$XVAL("silnml",vals) learn=learn_" Mailed letter"
"RTN","SAMINOT1",347,0)
 s:$$XVAL("silnpp",vals) learn=learn_" Message in patient portal"
"RTN","SAMINOT1",348,0)
 s:$$XVAL("silnvd",vals) learn=learn_" Video-on-Demand (VOD)"
"RTN","SAMINOT1",349,0)
 s:$$XVAL("silnot",vals) learn=learn_" "_$$XVAL("silnoo",vals)
"RTN","SAMINOT1",350,0)
 d OUT("   "_"How did you learn about the Lung Screening Program?: "_learn)
"RTN","SAMINOT1",351,0)
 n verified s verified=""
"RTN","SAMINOT1",352,0)
 s:$$XVAL("sipav",vals)="y" verified="Yes"
"RTN","SAMINOT1",353,0)
 s:$$XVAL("sipav",vals)="n" verified="No"
"RTN","SAMINOT1",354,0)
 d OUT("   "_"Primary address verified: "_verified)
"RTN","SAMINOT1",355,0)
 n rural s rural=""
"RTN","SAMINOT1",356,0)
 s:$$XVAL("sirs",vals)="r" rural="rural"
"RTN","SAMINOT1",357,0)
 s:$$XVAL("sirs",vals)="u" rural="urban"
"RTN","SAMINOT1",358,0)
 d OUT("   "_""_"Rural status: "_rural)
"RTN","SAMINOT1",359,0)
 d OUT("   "_"Preferred address and contact number: ")
"RTN","SAMINOT1",360,0)
 n pa s pa=""
"RTN","SAMINOT1",361,0)
 i $$XVAL("sipsa",vals)'="" d  ;
"RTN","SAMINOT1",362,0)
 . d OUT("      "_$$XVAL("sipsa",vals))
"RTN","SAMINOT1",363,0)
 . n csz s csz=""
"RTN","SAMINOT1",364,0)
 . s:$$XVAL("sipc",vals)'="" csz=$$XVAL("sipc",vals)
"RTN","SAMINOT1",365,0)
 . s:$$XVAL("sips",vals)'="" csz=csz_", "_$$XVAL("sips",vals)
"RTN","SAMINOT1",366,0)
 . s:$$XVAL("sipz",vals)'="" csz=csz_" "_$$XVAL("sipz",vals)
"RTN","SAMINOT1",367,0)
 . d OUT("      "_csz)
"RTN","SAMINOT1",368,0)
 d:$$XVAL("sippn",vals)'="" OUT("      "_$$XVAL("sippn",vals))
"RTN","SAMINOT1",369,0)
 d OUT("   "_"Ever smoked?: ")
"RTN","SAMINOT1",370,0)
 d OUT("      "_$$XVAL("sies",vals))
"RTN","SAMINOT1",371,0)
 n sstatus s sstatus=""
"RTN","SAMINOT1",372,0)
 s:$$XVAL("siesm",vals)="n" sstatus=sstatus_" Never smoked"
"RTN","SAMINOT1",373,0)
 s:$$XVAL("siesm",vals)="p" sstatus=sstatus_" Past"
"RTN","SAMINOT1",374,0)
 s:$$XVAL("siesm",vals)="c" sstatus=sstatus_" Current"
"RTN","SAMINOT1",375,0)
 s:$$XVAL("siesq",vals)=1 sstatus=sstatus_" Willing to quit"
"RTN","SAMINOT1",376,0)
 d OUT("   Smoking Status: "_sstatus)
"RTN","SAMINOT1",377,0)
 d OUT("   "_"CIGs per day: ")
"RTN","SAMINOT1",378,0)
 d OUT("      "_$$XVAL("sicpd",vals))
"RTN","SAMINOT1",379,0)
 d OUT("   "_"PPD: ")
"RTN","SAMINOT1",380,0)
 d OUT("      "_$$XVAL("sippd",vals))
"RTN","SAMINOT1",381,0)
 d OUT("   "_"# of years: ")
"RTN","SAMINOT1",382,0)
 d OUT("      "_$$XVAL("sisny",vals))
"RTN","SAMINOT1",383,0)
 d OUT("   "_"PPY: ")
"RTN","SAMINOT1",384,0)
 d OUT("      "_$$XVAL("sippy",vals))
"RTN","SAMINOT1",385,0)
 d OUT("")
"RTN","SAMINOT1",386,0)
 i $$XVAL("siq",vals)'="" d  ;
"RTN","SAMINOT1",387,0)
 . d OUT("Quit smoking on: "_$$XVAL("siq",vals))
"RTN","SAMINOT1",388,0)
 . d OUT("")
"RTN","SAMINOT1",389,0)
 i $$XVAL("sicep",vals)'="" d  ;
"RTN","SAMINOT1",390,0)
 . d OUT("Smoking cessation education provided:")
"RTN","SAMINOT1",391,0)
 . d OUT("    "_$$XVAL("sicep",vals))
"RTN","SAMINOT1",392,0)
 i $$XVAL("sicadx",vals)'="" d
"RTN","SAMINOT1",393,0)
 . d OUT("Prior lung cancer diagnosis date: "_$$XVAL("sicadx",vals))
"RTN","SAMINOT1",394,0)
 . i $$XVAL("sicadxl",vals)'="" d  ;
"RTN","SAMINOT1",395,0)
 . . d OUT("Location where prior lung cancer diagnosis was made:")
"RTN","SAMINOT1",396,0)
 . . d OUT("    "_$$XVAL("sicadxl",vals))
"RTN","SAMINOT1",397,0)
 i $$XVAL("siptct",vals)'="" d
"RTN","SAMINOT1",398,0)
 . d OUT("Prior CT: "_$$XVAL("siptct",vals))
"RTN","SAMINOT1",399,0)
 . i $$XVAL("siptctl",vals)'="" d  ;
"RTN","SAMINOT1",400,0)
 . . d OUT("Location where prior CT was made:")
"RTN","SAMINOT1",401,0)
 . . d OUT("    "_$$XVAL("siptctl",vals))
"RTN","SAMINOT1",402,0)
 d OUT(" ")
"RTN","SAMINOT1",403,0)
 d OUT("Shared Decision Making: ")
"RTN","SAMINOT1",404,0)
 d OUT(" ")
"RTN","SAMINOT1",405,0)
 n sdm s sdm=""
"RTN","SAMINOT1",406,0)
 s sdm=sdm_"Veteran of age and exposure to cigarette smoke as described above, and without a "
"RTN","SAMINOT1",407,0)
 s sdm=sdm_"current diagnosis or obvious symptoms suggestive of lung cancer, has been educated "
"RTN","SAMINOT1",408,0)
 s sdm=sdm_"today about the estimated risk for lung cancer, the possibility of a cure or life "
"RTN","SAMINOT1",409,0)
 s sdm=sdm_"prolonging if an early lung cancer were to be found during screening, the possibility of "
"RTN","SAMINOT1",410,0)
 s sdm=sdm_"imaging abnormalities not being lung cancer, the possibility of complications from "
"RTN","SAMINOT1",411,0)
 s sdm=sdm_"additional diagnostic procedures, and the approximate amount of radiation exposure "
"RTN","SAMINOT1",412,0)
 s sdm=sdm_"associated with each screening procedure. In addition, the veteran has been educated "
"RTN","SAMINOT1",413,0)
 s sdm=sdm_"today about the importance of avoiding exposure to cigarette smoke, available tobacco "
"RTN","SAMINOT1",414,0)
 s sdm=sdm_"cessation programs and available lung screening services at this VA facility. Education "
"RTN","SAMINOT1",415,0)
 s sdm=sdm_"material was provided to the veteran."
"RTN","SAMINOT1",416,0)
 s sdm=sdm_"Veteran of age and exposure to cigarette smoke as described above, and without a "
"RTN","SAMINOT1",417,0)
 s sdm=sdm_"current diagnosis or obvious symptoms suggestive of lung cancer, has been educated "
"RTN","SAMINOT1",418,0)
 s sdm=sdm_"today about the estimated risk for lung cancer, the possibility of a cure or life "
"RTN","SAMINOT1",419,0)
 s sdm=sdm_"prolonging if an early lung cancer were to be found during screening, the possibility of "
"RTN","SAMINOT1",420,0)
 s sdm=sdm_"imaging abnormalities not being lung cancer, the possibility of complications from "
"RTN","SAMINOT1",421,0)
 s sdm=sdm_"additional diagnostic procedures, and the approximate amount of radiation exposure "
"RTN","SAMINOT1",422,0)
 s sdm=sdm_"associated with each screening procedure. In addition, the veteran has been educated "
"RTN","SAMINOT1",423,0)
 s sdm=sdm_"today about the importance of avoiding exposure to cigarette smoke, available tobacco "
"RTN","SAMINOT1",424,0)
 s sdm=sdm_"cessation programs and available lung screening services at this VA facility. Education "
"RTN","SAMINOT1",425,0)
 s sdm=sdm_"material was provided to the veteran."
"RTN","SAMINOT1",426,0)
 d OUT(sdm)
"RTN","SAMINOT1",427,0)
 ;d OUT(" ")
"RTN","SAMINOT1",428,0)
 ;d OUT("Veteran of age and exposure to cigarette smoke as described above, and without")
"RTN","SAMINOT1",429,0)
 ;d OUT("a current diagnosis or obvious symptoms suggestive of lung cancer, has been")
"RTN","SAMINOT1",430,0)
 ;d OUT("educated today about the estimated risk for lung cancer, the possibility of")
"RTN","SAMINOT1",431,0)
 ;d OUT("cure or life prolonging if an early lung cancer were to be found during")
"RTN","SAMINOT1",432,0)
 ;d OUT("screening, the possibility of imaging abnormalities not being lung cancer, the")
"RTN","SAMINOT1",433,0)
 ;d OUT("possibility of complications from additional diagnostic procedures, and the")
"RTN","SAMINOT1",434,0)
 ;d OUT("approximate amount of radiation exposure associated with each screening")
"RTN","SAMINOT1",435,0)
 ;d OUT("procedure.  In addition, the veteran has been educated today about the")
"RTN","SAMINOT1",436,0)
 ;d OUT("importance of adhering to annual lung screening, the possible impact of other")
"RTN","SAMINOT1",437,0)
 ;d OUT("medical conditions on the overall health status, the importance of avoiding")
"RTN","SAMINOT1",438,0)
 ;d OUT("exposure to cigarette smoke, available tobacco cessation programs and")
"RTN","SAMINOT1",439,0)
 ;d OUT("available lung screening services at the Phoenix VA.  Education material was")
"RTN","SAMINOT1",440,0)
 ;d OUT("provided to the veteran.  Based on this information, the veteran has opted")
"RTN","SAMINOT1",441,0)
 ;d OUT("for: ")
"RTN","SAMINOT1",442,0)
 d OUT(" ")
"RTN","SAMINOT1",443,0)
 n ldct s ldct=""
"RTN","SAMINOT1",444,0)
 s:$$XVAL("sildct",vals)="n" ldct="No"
"RTN","SAMINOT1",445,0)
 s:$$XVAL("sildct",vals)="l" ldct="No"
"RTN","SAMINOT1",446,0)
 s:$$XVAL("sildct",vals)="y" ldct="Yes"
"RTN","SAMINOT1",447,0)
 d OUT("The veteran has decided to enroll in the Lung Screening Program: "_ldct)
"RTN","SAMINOT1",448,0)
 i $$XVAL("sildct",vals)="l" d  ;
"RTN","SAMINOT1",449,0)
 . d OUT("The veteran has indicated it is okay to contact in the future to discuss enrolling in the Lung Screening Program.")
"RTN","SAMINOT1",450,0)
 i ldct="Yes" d  ;
"RTN","SAMINOT1",451,0)
 . d OUT("LDCT ordered: "_ldct)
"RTN","SAMINOT1",452,0)
 . d OUT("    "_"Veteran enrolled in the LSS program. Results and coordination of care ")
"RTN","SAMINOT1",453,0)
 . d OUT("    "_"will be made by the LSS team.  ")
"RTN","SAMINOT1",454,0)
 . i $$XVAL("siclin",vals)'="" d  ;
"RTN","SAMINOT1",455,0)
 . d OUT("Clinical Indications for Initial Screening CT:")
"RTN","SAMINOT1",456,0)
 . d OUT("    "_$$XVAL("siclin",vals))
"RTN","SAMINOT1",457,0)
 ;
"RTN","SAMINOT1",458,0)
 ;The veteran has decided to enroll in the Lung Screening Program: [Yes/No]
"RTN","SAMINOT1",459,0)
 ;
"RTN","SAMINOT1",460,0)
 ;[If Not enroll at this time but okay to contact in the future, add the following line]
"RTN","SAMINOT1",461,0)
 ;The veteran has indicated it is okay to contact in the future to discuss enrolling in the Lung Screening Program.
"RTN","SAMINOT1",462,0)
 ;
"RTN","SAMINOT1",463,0)
 ;[If Yes is answered for enrollment add the following two lines]
"RTN","SAMINOT1",464,0)
 ;LDCT ordered:                Yes
"RTN","SAMINOT1",465,0)
 ;Veteran enrolled in the Lung Screening Program. Results and coordination of care will be made by the Lung Screening Program team.
"RTN","SAMINOT1",466,0)
 ;
"RTN","SAMINOT1",467,0)
 ;[If Clinical Indication text is provided add them to the note]
"RTN","SAMINOT1",468,0)
 ;Clinical Indications:          [Show Input Text]
"RTN","SAMINOT1",469,0)
 ;
"RTN","SAMINOT1",470,0)
 ;
"RTN","SAMINOT1",471,0)
 q
"RTN","SAMINOT1",472,0)
 ;
"RTN","SAMINOT1",473,0)
OUT(ln) ;
"RTN","SAMINOT1",474,0)
 s cnt=cnt+1
"RTN","SAMINOT1",475,0)
 n lnn
"RTN","SAMINOT1",476,0)
 ;s debug=1
"RTN","SAMINOT1",477,0)
 s lnn=$o(@dest@(" "),-1)+1
"RTN","SAMINOT1",478,0)
 s @dest@(lnn)=ln
"RTN","SAMINOT1",479,0)
 ;i $g(debug)=1 d  ;
"RTN","SAMINOT1",480,0)
 ;. i ln["<" q  ; no markup
"RTN","SAMINOT1",481,0)
 ;. n zs s zs=$STACK
"RTN","SAMINOT1",482,0)
 ;. n zp s zp=$STACK(zs-2,"PLACE")
"RTN","SAMINOT1",483,0)
 ;. s @dest@(lnn)=zp_":"_ln
"RTN","SAMINOT1",484,0)
 q
"RTN","SAMINOT1",485,0)
 ;
"RTN","SAMINOT1",486,0)
XVAL(var,vals) ; extrinsic returns the patient value for var
"RTN","SAMINOT1",487,0)
 ; vals is passed by name
"RTN","SAMINOT1",488,0)
 n zr
"RTN","SAMINOT1",489,0)
 s zr=$g(@vals@(var))
"RTN","SAMINOT1",490,0)
 ;i zr="" s zr="["_var_"]"
"RTN","SAMINOT1",491,0)
 q zr
"RTN","SAMINOT1",492,0)
 ;
"RTN","SAMINOT1",493,0)
 ;
"VER")
8.0^22.2
**END**
**END**
