KIDS Distribution saved on Mar 24, 2022@14:57:36
Test Release SAMI*18.0*16 SEQ #16 (sami-18-16-t4)
**KIDS**:SAMI*18.0*16^

**INSTALL NAME**
SAMI*18.0*16
"BLD",11515,0)
SAMI*18.0*16^^0^3220324^n
"BLD",11515,1,0)
^^1^1^3220119^
"BLD",11515,1,1,0)
Test release SAMI*18.0*16 SEQ #16 T3
"BLD",11515,4,0)
^9.64PA^^
"BLD",11515,6.3)
4
"BLD",11515,"KRN",0)
^9.67PA^1.5^25
"BLD",11515,"KRN",.4,0)
.4
"BLD",11515,"KRN",.401,0)
.401
"BLD",11515,"KRN",.402,0)
.402
"BLD",11515,"KRN",.403,0)
.403
"BLD",11515,"KRN",.5,0)
.5
"BLD",11515,"KRN",.84,0)
.84
"BLD",11515,"KRN",1.5,0)
1.5
"BLD",11515,"KRN",1.6,0)
1.6
"BLD",11515,"KRN",1.61,0)
1.61
"BLD",11515,"KRN",1.62,0)
1.62
"BLD",11515,"KRN",3.6,0)
3.6
"BLD",11515,"KRN",3.8,0)
3.8
"BLD",11515,"KRN",9.2,0)
9.2
"BLD",11515,"KRN",9.8,0)
9.8
"BLD",11515,"KRN",9.8,"NM",0)
^9.68A^4^1
"BLD",11515,"KRN",9.8,"NM",4,0)
SAMIMOV^^0^B84568110
"BLD",11515,"KRN",9.8,"NM","B","SAMIMOV",4)

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

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

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

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

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

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

"BLD",11515,"KRN","B",1.5,1.5)

"BLD",11515,"KRN","B",1.6,1.6)

"BLD",11515,"KRN","B",1.61,1.61)

"BLD",11515,"KRN","B",1.62,1.62)

"BLD",11515,"KRN","B",3.6,3.6)

"BLD",11515,"KRN","B",3.8,3.8)

"BLD",11515,"KRN","B",9.2,9.2)

"BLD",11515,"KRN","B",9.8,9.8)

"BLD",11515,"KRN","B",19,19)

"BLD",11515,"KRN","B",19.1,19.1)

"BLD",11515,"KRN","B",101,101)

"BLD",11515,"KRN","B",409.61,409.61)

"BLD",11515,"KRN","B",771,771)

"BLD",11515,"KRN","B",779.2,779.2)

"BLD",11515,"KRN","B",870,870)

"BLD",11515,"KRN","B",8989.51,8989.51)

"BLD",11515,"KRN","B",8989.52,8989.52)

"BLD",11515,"KRN","B",8993,8993)

"BLD",11515,"KRN","B",8994,8994)

"BLD",11515,"QUES",0)
^9.62^^
"BLD",11515,"REQB",0)
^9.611^12^12
"BLD",11515,"REQB",1,0)
SAMI*18.0*1^0
"BLD",11515,"REQB",2,0)
SAMI*18.0*2^0
"BLD",11515,"REQB",3,0)
SAMI*18.0*3^0
"BLD",11515,"REQB",4,0)
SAMI*18.0*4^0
"BLD",11515,"REQB",5,0)
SAMI 18.0T05^0
"BLD",11515,"REQB",6,0)
SAMI*18.0*6^0
"BLD",11515,"REQB",7,0)
SAMI*18.0*8^0
"BLD",11515,"REQB",8,0)
SAMI*18.0*9^0
"BLD",11515,"REQB",9,0)
SAMI*18.0*10^0
"BLD",11515,"REQB",10,0)
SAMI*18.0*11^0
"BLD",11515,"REQB",11,0)
SAMI*18.0*12^0
"BLD",11515,"REQB",12,0)
SAMI*18.0*13^0
"BLD",11515,"REQB","B","SAMI 18.0T05",5)

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

"BLD",11515,"REQB","B","SAMI*18.0*10",9)

"BLD",11515,"REQB","B","SAMI*18.0*11",10)

"BLD",11515,"REQB","B","SAMI*18.0*12",11)

"BLD",11515,"REQB","B","SAMI*18.0*13",12)

"BLD",11515,"REQB","B","SAMI*18.0*2",2)

"BLD",11515,"REQB","B","SAMI*18.0*3",3)

"BLD",11515,"REQB","B","SAMI*18.0*4",4)

"BLD",11515,"REQB","B","SAMI*18.0*6",6)

"BLD",11515,"REQB","B","SAMI*18.0*8",7)

"BLD",11515,"REQB","B","SAMI*18.0*9",8)

"MBREQ")
0
"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")
1
"RTN","SAMIMOV")
0^4^B84568110
"RTN","SAMIMOV",1,0)
SAMIMOV ;ven/gpl - VAPALS CHANGE PATIENT SITE ; 2022-03-24t21:13z
"RTN","SAMIMOV",2,0)
 ;;18.0;SAMI;**7,15,16**;;Build 4
"RTN","SAMIMOV",3,0)
 ;;18-16
"RTN","SAMIMOV",4,0)
 ;
"RTN","SAMIMOV",5,0)
 ;@license: see routine SAMIUL
"RTN","SAMIMOV",6,0)
 ;
"RTN","SAMIMOV",7,0)
 ; allow fallthrough
"RTN","SAMIMOV",8,0)
 ;
"RTN","SAMIMOV",9,0)
 ;
"RTN","SAMIMOV",10,0)
 ;@section 0 primary development
"RTN","SAMIMOV",11,0)
 ;
"RTN","SAMIMOV",12,0)
 ;
"RTN","SAMIMOV",13,0)
 ;
"RTN","SAMIMOV",14,0)
 ;@routine-credits
"RTN","SAMIMOV",15,0)
 ;@dev-main George P. Lilly (gpl)
"RTN","SAMIMOV",16,0)
 ; gpl@vistaexpertise.net
"RTN","SAMIMOV",17,0)
 ;@dev-org-main Vista Expertise Network (ven)
"RTN","SAMIMOV",18,0)
 ; http://vistaexpertise.net
"RTN","SAMIMOV",19,0)
 ;@copyright 2021, gpl, all rights reserved
"RTN","SAMIMOV",20,0)
 ;@license see routine SAMIUL
"RTN","SAMIMOV",21,0)
 ;
"RTN","SAMIMOV",22,0)
 ;@last-update 2022-03-24t21:13z
"RTN","SAMIMOV",23,0)
 ;@application Screening Applications Management (SAM)
"RTN","SAMIMOV",24,0)
 ;@module Screening Applications Management - IELCAP (SAMI)
"RTN","SAMIMOV",25,0)
 ;@suite-of-files SAMI Forms (311.101-311.199)
"RTN","SAMIMOV",26,0)
 ;@version 18.15
"RTN","SAMIMOV",27,0)
 ;@release-date 2020-01
"RTN","SAMIMOV",28,0)
 ;@patch-list **7,15**
"RTN","SAMIMOV",29,0)
 ;
"RTN","SAMIMOV",30,0)
 ;@dev-add Frederick D. S. Marshall (toad)
"RTN","SAMIMOV",31,0)
 ; toad@vistaexpertise.net
"RTN","SAMIMOV",32,0)
 ;@dev-add Kenneth W. McGlothlen (mcglk)
"RTN","SAMIMOV",33,0)
 ; mcglk@vistaexpertise.net
"RTN","SAMIMOV",34,0)
 ;@dev-add Linda M. R. Yaw (lmry)
"RTN","SAMIMOV",35,0)
 ; linda.yaw@vistaexpertise.net
"RTN","SAMIMOV",36,0)
 ;
"RTN","SAMIMOV",37,0)
 ;@routine-log repo github.com:VA-PALS-ELCAP/SAMI-VAPALS-ELCAP.git
"RTN","SAMIMOV",38,0)
 ; 2020-08-24 ven/gpl 18-7 915b85e6
"RTN","SAMIMOV",39,0)
 ;  SAMIMOV create utility to change patient site
"RTN","SAMIMOV",40,0)
 ; 2020-09-03 ven/gpl 5ae08772
"RTN","SAMIMOV",41,0)
 ;  SAMIMOV upgrade CHANGE SITE to handle patients without forms ... also
"RTN","SAMIMOV",42,0)
 ;  AUDIT report
"RTN","SAMIMOV",43,0)
 ; 2020-09-07 ven/gpl 498e57d5
"RTN","SAMIMOV",44,0)
 ;  SAMIMOV tweeking the audit report
"RTN","SAMIMOV",45,0)
 ; 2020-12-11 ven/gpl 92138cdb
"RTN","SAMIMOV",46,0)
 ; 2021-10-26 ven/gpl 18-15 d12b1b10
"RTN","SAMIMOV",47,0)
 ;  SAMIMOV parameter detection routine for identifying VA systems
"RTN","SAMIMOV",48,0)
 ; 2021-10-29 ven/lmry 18-15
"RTN","SAMIMOV",49,0)
 ;  SAMIMOV insert section 0, bump versions and dates, added semicolon after
"RTN","SAMIMOV",50,0)
 ;  PICSITE for XINDEX
"RTN","SAMIMOV",51,0)
 ; 2022-03-24 ven/gpl add ability to create a site index showing patients and
"RTN","SAMIMOV",52,0)
 ;  the ability to automatically move duplicated entries to another site to fix
"RTN","SAMIMOV",53,0)
 ;  a problem with inputting data from a spreadsheet.
"RTN","SAMIMOV",54,0)
 ; 2022-03-24 ven/lmry Update date and contents list
"RTN","SAMIMOV",55,0)
 ; 
"RTN","SAMIMOV",56,0)
 ;
"RTN","SAMIMOV",57,0)
 ;@contents
"RTN","SAMIMOV",58,0)
 ; EN entry point to change a patient's site
"RTN","SAMIMOV",59,0)
 ; DEDUP move duplicate patient records from one site to another
"RTN","SAMIMOV",60,0)
 ; SITEIDX generate a siteid index in the patient lookup graph
"RTN","SAMIMOV",61,0)
 ; MOV change patient PAT from site FROM to site TO 
"RTN","SAMIMOV",62,0)
 ; SETSID propogate the new sid to all forms
"RTN","SAMIMOV",63,0)
 ; PICPAT pick a patient in site SITE
"RTN","SAMIMOV",64,0)
 ; PICSITE()
"RTN","SAMIMOV",65,0)
 ; AUDIT()
"RTN","SAMIMOV",66,0)
 ; outaudit(rpt,ln)
"RTN","SAMIMOV",67,0)
 ; 
"RTN","SAMIMOV",68,0)
 ;
"RTN","SAMIMOV",69,0)
 ;
"RTN","SAMIMOV",70,0)
 ;
"RTN","SAMIMOV",71,0)
 ;@section 1 subroutines
"RTN","SAMIMOV",72,0)
 ;
"RTN","SAMIMOV",73,0)
EN ; entry point to change a patient's site
"RTN","SAMIMOV",74,0)
 ;
"RTN","SAMIMOV",75,0)
 n FROM,TO,PAT
"RTN","SAMIMOV",76,0)
 W !,"Pick the FROM Site -"
"RTN","SAMIMOV",77,0)
 S FROM=$$PICSITE()
"RTN","SAMIMOV",78,0)
 IF FROM="^" Q  ;
"RTN","SAMIMOV",79,0)
 ;
"RTN","SAMIMOV",80,0)
 W !,"Pick the TO Site -"
"RTN","SAMIMOV",81,0)
 S TO=$$PICSITE()
"RTN","SAMIMOV",82,0)
 IF TO="^" Q  ;
"RTN","SAMIMOV",83,0)
 ;
"RTN","SAMIMOV",84,0)
 D PICPAT(.PAT,FROM)
"RTN","SAMIMOV",85,0)
 I $G(PAT("name"))="" D  Q  ;
"RTN","SAMIMOV",86,0)
 . W !,"No patient selected, canceling"
"RTN","SAMIMOV",87,0)
 K DIR
"RTN","SAMIMOV",88,0)
 S DIR("A")="Confirm change site of patient "_PAT("name")_" from "_FROM_" to "_TO
"RTN","SAMIMOV",89,0)
 S DIR(0)="Y"
"RTN","SAMIMOV",90,0)
 D ^DIR
"RTN","SAMIMOV",91,0)
 ;
"RTN","SAMIMOV",92,0)
 I Y'=1 D  Q  ;
"RTN","SAMIMOV",93,0)
 . W !,"Cancel, no change made"
"RTN","SAMIMOV",94,0)
 ;
"RTN","SAMIMOV",95,0)
 do MOV(.PAT,FROM,TO)
"RTN","SAMIMOV",96,0)
 q
"RTN","SAMIMOV",97,0)
 ;
"RTN","SAMIMOV",98,0)
DEDUP() ; remove duplicate names from a site
"RTN","SAMIMOV",99,0)
 ;
"RTN","SAMIMOV",100,0)
 n FROM,TO,PAT
"RTN","SAMIMOV",101,0)
 W !,"Pick the FROM Site -"
"RTN","SAMIMOV",102,0)
 S FROM=$$PICSITE()
"RTN","SAMIMOV",103,0)
 IF FROM="^" Q  ;
"RTN","SAMIMOV",104,0)
 ;
"RTN","SAMIMOV",105,0)
 W !,"Pick the TO Site -"
"RTN","SAMIMOV",106,0)
 S TO=$$PICSITE()
"RTN","SAMIMOV",107,0)
 IF TO="^" Q  ;
"RTN","SAMIMOV",108,0)
 ;
"RTN","SAMIMOV",109,0)
 K DIR
"RTN","SAMIMOV",110,0)
 S DIR("A")="Confirm removing duplicates from  "_FROM_" by moving them to "_TO
"RTN","SAMIMOV",111,0)
 S DIR(0)="Y"
"RTN","SAMIMOV",112,0)
 D ^DIR
"RTN","SAMIMOV",113,0)
 ;
"RTN","SAMIMOV",114,0)
 I Y'=1 D  Q  ;
"RTN","SAMIMOV",115,0)
 . W !,"Cancel, no change made"
"RTN","SAMIMOV",116,0)
 ;
"RTN","SAMIMOV",117,0)
 d SITEIDX ; insure we have a site index
"RTN","SAMIMOV",118,0)
 n lroot s lroot=$$setroot^%wd("patient-lookup")
"RTN","SAMIMOV",119,0)
 q:lroot=""
"RTN","SAMIMOV",120,0)
 n site s site=FROM
"RTN","SAMIMOV",121,0)
 n gn s gn=$na(@lroot@("siteid",site))
"RTN","SAMIMOV",122,0)
 i '$d(@gn) d  q  ;
"RTN","SAMIMOV",123,0)
 . w !,"Error name index not found"
"RTN","SAMIMOV",124,0)
 n zi,zj
"RTN","SAMIMOV",125,0)
 s zi=""
"RTN","SAMIMOV",126,0)
 f  s zi=$o(@gn@(zi)) q:zi=""  d  ;
"RTN","SAMIMOV",127,0)
 . s zj=$o(@gn@(zi,"")) ; ien of non-duplicate record
"RTN","SAMIMOV",128,0)
 . q:$g(@lroot@(zj,"siteid"))'=FROM
"RTN","SAMIMOV",129,0)
 . f  s zj=$o(@gn@(zi,zj)) q:zj=""  d  ;
"RTN","SAMIMOV",130,0)
 . . q:'$d(@lroot@(zj))
"RTN","SAMIMOV",131,0)
 . . m PAT=@lroot@(zj)
"RTN","SAMIMOV",132,0)
 . . q:$g(PAT("siteid"))'=FROM
"RTN","SAMIMOV",133,0)
 . . w !,"found a duplicate "_zi_" "_zj
"RTN","SAMIMOV",134,0)
 . . do MOV(.PAT,FROM,TO)
"RTN","SAMIMOV",135,0)
 . . K PAT
"RTN","SAMIMOV",136,0)
 D SITEIDX
"RTN","SAMIMOV",137,0)
 q
"RTN","SAMIMOV",138,0)
 ;
"RTN","SAMIMOV",139,0)
SITEIDX() ; generate a siteid index in the patient lookup graph
"RTN","SAMIMOV",140,0)
 n lroot s lroot=$$setroot^%wd("patient-lookup")
"RTN","SAMIMOV",141,0)
 q:lroot=""
"RTN","SAMIMOV",142,0)
 k @lroot@("siteid")
"RTN","SAMIMOV",143,0)
 n site,nm,ien
"RTN","SAMIMOV",144,0)
 s (site,nm)=""
"RTN","SAMIMOV",145,0)
 s ien=0
"RTN","SAMIMOV",146,0)
 f  s ien=$o(@lroot@(ien)) q:+ien=0  d  ;
"RTN","SAMIMOV",147,0)
 . s site=$g(@lroot@(ien,"siteid"))
"RTN","SAMIMOV",148,0)
 . ;q:site="XXX"
"RTN","SAMIMOV",149,0)
 . ;w !,ien_" site: "_site
"RTN","SAMIMOV",150,0)
 . s nm=$g(@lroot@(ien,"saminame"))
"RTN","SAMIMOV",151,0)
 . q:nm=""
"RTN","SAMIMOV",152,0)
 . q:site=""
"RTN","SAMIMOV",153,0)
 . s @lroot@("siteid",site,nm,ien)=""
"RTN","SAMIMOV",154,0)
 q
"RTN","SAMIMOV",155,0)
 ;
"RTN","SAMIMOV",156,0)
MOV(PAT,FROM,TO) ; change patient PAT from site FROM to site TO
"RTN","SAMIMOV",157,0)
 ;
"RTN","SAMIMOV",158,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIMOV",159,0)
 n lroot s lroot=$$setroot^%wd("patient-lookup")
"RTN","SAMIMOV",160,0)
 n dfn s dfn=$g(PAT("dfn"))
"RTN","SAMIMOV",161,0)
 i dfn="" d  q  ;
"RTN","SAMIMOV",162,0)
 . w !,"Error, patient not valid"
"RTN","SAMIMOV",163,0)
 n lien
"RTN","SAMIMOV",164,0)
 s lien=$o(@lroot@("dfn",dfn,""))
"RTN","SAMIMOV",165,0)
 i $g(@lroot@(lien,"siteid"))'=FROM d  q  ;
"RTN","SAMIMOV",166,0)
 . w !,"Error, from site not valid for patient"
"RTN","SAMIMOV",167,0)
 ;
"RTN","SAMIMOV",168,0)
 n pien s pien=$o(@root@("dfn",dfn,""))
"RTN","SAMIMOV",169,0)
 i pien="" d  q  ;
"RTN","SAMIMOV",170,0)
 . w !,"Patient has no forms"
"RTN","SAMIMOV",171,0)
 . s @lroot@(lien,"siteid")=TO
"RTN","SAMIMOV",172,0)
 . w !,"Change successful"
"RTN","SAMIMOV",173,0)
 ;
"RTN","SAMIMOV",174,0)
 n oldsid s oldsid=$g(@root@(pien,"studyid"))
"RTN","SAMIMOV",175,0)
 i oldsid="" s oldsid=$g(@root@(pien,"samistudyid"))
"RTN","SAMIMOV",176,0)
 w !,"oldsid=",oldsid
"RTN","SAMIMOV",177,0)
 i oldsid="" d  q  ;
"RTN","SAMIMOV",178,0)
 . w !,"Error studyid not found"
"RTN","SAMIMOV",179,0)
 ;b
"RTN","SAMIMOV",180,0)
 s @lroot@(lien,"siteid")=TO
"RTN","SAMIMOV",181,0)
 s PAT("siteid")=TO
"RTN","SAMIMOV",182,0)
 k @root@("sid",oldsid,pien) ; remove sid index
"RTN","SAMIMOV",183,0)
 ;
"RTN","SAMIMOV",184,0)
 n newsid s newsid=$$GENSTDID^SAMIHOM3(dfn,.PAT)
"RTN","SAMIMOV",185,0)
 s @lroot@(lien,"studyid")=newsid
"RTN","SAMIMOV",186,0)
 s @root@(pien,"studyid")=newsid
"RTN","SAMIMOV",187,0)
 s @root@(pien,"sisid")=newsid
"RTN","SAMIMOV",188,0)
 s @root@(pien,"samistudyid")=newsid
"RTN","SAMIMOV",189,0)
 s @root@("sid",newsid,pien)=""
"RTN","SAMIMOV",190,0)
 ;
"RTN","SAMIMOV",191,0)
 w !,"New studyid = "_newsid
"RTN","SAMIMOV",192,0)
 m @root@("graph",newsid)=@root@("graph",oldsid)
"RTN","SAMIMOV",193,0)
 d SETSID(newsid) ;propogate the new sid to all forms
"RTN","SAMIMOV",194,0)
 k @root@("graph",oldsid)
"RTN","SAMIMOV",195,0)
 w !,"Change successful"
"RTN","SAMIMOV",196,0)
 ;
"RTN","SAMIMOV",197,0)
 q
"RTN","SAMIMOV",198,0)
 ;
"RTN","SAMIMOV",199,0)
SETSID(newsid) ; propogate the new sid to all forms
"RTN","SAMIMOV",200,0)
 n root s root=$$setroot^%wd("vapals-patients")
"RTN","SAMIMOV",201,0)
 n zi s zi=""
"RTN","SAMIMOV",202,0)
 f  s zi=$o(@root@("graph",newsid,zi)) q:zi=""  d  ;
"RTN","SAMIMOV",203,0)
 . s @root@("graph",newsid,zi,"samistudyid")=newsid
"RTN","SAMIMOV",204,0)
 . s @root@("graph",newsid,zi,"studyid")=newsid
"RTN","SAMIMOV",205,0)
 . s @root@("graph",newsid,zi,"sisid")=newsid
"RTN","SAMIMOV",206,0)
 q
"RTN","SAMIMOV",207,0)
 ;
"RTN","SAMIMOV",208,0)
PICPAT(PATRTN,SITE) ; pick a patient in site SITE
"RTN","SAMIMOV",209,0)
 ;
"RTN","SAMIMOV",210,0)
 N FILTER,LIST,X,Y
"RTN","SAMIMOV",211,0)
 I $G(SITE)="" S SITE="*"
"RTN","SAMIMOV",212,0)
 S FILTER("site")=$G(SITE)
"RTN","SAMIMOV",213,0)
 S FILTER("format")="array"
"RTN","SAMIMOV",214,0)
 ;
"RTN","SAMIMOV",215,0)
 new DIR set DIR(0)="F^1:120" ; free text
"RTN","SAMIMOV",216,0)
 set DIR("A")="Patient name: " ; prompt
"RTN","SAMIMOV",217,0)
 set DIR("B")="""" ; default
"RTN","SAMIMOV",218,0)
 ;
"RTN","SAMIMOV",219,0)
 d ^DIR
"RTN","SAMIMOV",220,0)
 ;
"RTN","SAMIMOV",221,0)
 S FILTER("search")=Y
"RTN","SAMIMOV",222,0)
 D WSPTLKUP^SAMIPTLK(.LIST,.FILTER)
"RTN","SAMIMOV",223,0)
 ;ZWR LIST(:,:,"name")
"RTN","SAMIMOV",224,0)
 ;
"RTN","SAMIMOV",225,0)
 N LCNT S LCNT=$O(LIST("result",""),-1)
"RTN","SAMIMOV",226,0)
 Q:+LCNT=0
"RTN","SAMIMOV",227,0)
 S Y=1
"RTN","SAMIMOV",228,0)
 I LCNT>1 D  ; more than one in the list
"RTN","SAMIMOV",229,0)
 . K DIR
"RTN","SAMIMOV",230,0)
 . N ZI S ZI=0
"RTN","SAMIMOV",231,0)
 . S DIR("A")="Select the patient"
"RTN","SAMIMOV",232,0)
 . F  S ZI=$O(LIST("result",ZI)) Q:+ZI=0  D  ;
"RTN","SAMIMOV",233,0)
 . . S DIR("A",ZI)=ZI_" "_LIST("result",ZI,"name")_" "_LIST("result",ZI,"last5")
"RTN","SAMIMOV",234,0)
 . S DIR(0)="N^1:"_LCNT_":0"
"RTN","SAMIMOV",235,0)
 . D ^DIR
"RTN","SAMIMOV",236,0)
 . ;W !,"Y=",Y
"RTN","SAMIMOV",237,0)
 I +Y>0 M PATRTN=LIST("result",Y)
"RTN","SAMIMOV",238,0)
 q
"RTN","SAMIMOV",239,0)
 ;
"RTN","SAMIMOV",240,0)
PICSITE()  ;
"RTN","SAMIMOV",241,0)
 ;
"RTN","SAMIMOV",242,0)
 ; pick a site
"RTN","SAMIMOV",243,0)
 N X,Y,DIC,SITEIEN,SITEID
"RTN","SAMIMOV",244,0)
 S DIC=311.12
"RTN","SAMIMOV",245,0)
 S DIC(0)="AEMQ"
"RTN","SAMIMOV",246,0)
 D ^DIC
"RTN","SAMIMOV",247,0)
 I Y<1 Q  ; EXIT
"RTN","SAMIMOV",248,0)
 S SITENUM=$P(Y,"^",2)
"RTN","SAMIMOV",249,0)
 S SITEID=$$SITEID^SAMISITE(SITENUM)
"RTN","SAMIMOV",250,0)
 Q SITEID
"RTN","SAMIMOV",251,0)
 ;
"RTN","SAMIMOV",252,0)
AUDIT() ;
"RTN","SAMIMOV",253,0)
 ;
"RTN","SAMIMOV",254,0)
 n proot s proot=$$setroot^%wd("vapals-patients")
"RTN","SAMIMOV",255,0)
 n lroot s lroot=$$setroot^%wd("patient-lookup")
"RTN","SAMIMOV",256,0)
 n rpt s rpt=$na(^TMP("SAMIAUDIT",$J))
"RTN","SAMIMOV",257,0)
 k @rpt
"RTN","SAMIMOV",258,0)
 d outaudit(rpt,"cdate NAME  lien  dfn site  PNAME  pien  pdfn sid")
"RTN","SAMIMOV",259,0)
 n ln,lname,lien,cdate,pname,pien,ldfn,pdfn,site,sid
"RTN","SAMIMOV",260,0)
 s (ln,lname,lien,site,cdate,pname,pien,ldfn,pdfn,sid)=""
"RTN","SAMIMOV",261,0)
 n zi s zi=" "
"RTN","SAMIMOV",262,0)
 f  s zi=$o(@lroot@(zi),-1) q:+zi=0  d  ;
"RTN","SAMIMOV",263,0)
 . s lien=zi
"RTN","SAMIMOV",264,0)
 . s site=$g(@lroot@(zi,"siteid"))
"RTN","SAMIMOV",265,0)
 . s lname=$g(@lroot@(zi,"saminame"))
"RTN","SAMIMOV",266,0)
 . s ldfn=$g(@lroot@(zi,"dfn"))
"RTN","SAMIMOV",267,0)
 . i ldfn="" d  q  ;
"RTN","SAMIMOV",268,0)
 . . ;d ^ZTER
"RTN","SAMIMOV",269,0)
 . . w !,"error ",zi
"RTN","SAMIMOV",270,0)
 . . s ln="error, missing dfn lien="_lien
"RTN","SAMIMOV",271,0)
 . . s ln=ln_" "_$g(@lroot@(zi,"saminame"))
"RTN","SAMIMOV",272,0)
 . . d outaudit(rpt,ln)
"RTN","SAMIMOV",273,0)
 . . s ln=""
"RTN","SAMIMOV",274,0)
 . i $o(@lroot@("dfn",ldfn,""))'=lien d  ;
"RTN","SAMIMOV",275,0)
 . . w !,"error in dfn index dfn="_ldfn_" lien="_lien
"RTN","SAMIMOV",276,0)
 . s pien=$o(@proot@("dfn",ldfn,""))
"RTN","SAMIMOV",277,0)
 . i +pien'=0 d  ;
"RTN","SAMIMOV",278,0)
 . . s cdate=$g(@proot@(pien,"samicreatedate"))
"RTN","SAMIMOV",279,0)
 . . s pname=$g(@proot@(pien,"saminame"))
"RTN","SAMIMOV",280,0)
 . . s pdfn=$g(@proot@(pien,"dfn"))
"RTN","SAMIMOV",281,0)
 . . s sid=$g(@proot@(pien,"samistudyid"))
"RTN","SAMIMOV",282,0)
 . s ln=ln_$g(cdate)_" "
"RTN","SAMIMOV",283,0)
 . s ln=ln_$e(lname,1,20)_"  "
"RTN","SAMIMOV",284,0)
 . s ln=ln_$J(lien,5)
"RTN","SAMIMOV",285,0)
 . s ln=ln_$j(ldfn,8)
"RTN","SAMIMOV",286,0)
 . s ln=ln_" "_site_" "
"RTN","SAMIMOV",287,0)
 . s ln=ln_" "_$e(pname,1,20)_" "
"RTN","SAMIMOV",288,0)
 . s ln=ln_$j(pien,5)
"RTN","SAMIMOV",289,0)
 . i pien="" s ln=ln_"Not Enrolled"
"RTN","SAMIMOV",290,0)
 . s ln=ln_$j(pdfn,8)
"RTN","SAMIMOV",291,0)
 . s ln=ln_" "_sid
"RTN","SAMIMOV",292,0)
 . d outaudit(rpt,ln)
"RTN","SAMIMOV",293,0)
 . s (ln,lname,lien,site,cdate,pname,pien,ldfn,pdfn,sid)=""
"RTN","SAMIMOV",294,0)
 ;B
"RTN","SAMIMOV",295,0)
 D BROWSE^DDBR(rpt,"N","audit")
"RTN","SAMIMOV",296,0)
 ;
"RTN","SAMIMOV",297,0)
 q
"RTN","SAMIMOV",298,0)
 ;
"RTN","SAMIMOV",299,0)
outaudit(rpt,ln) ;
"RTN","SAMIMOV",300,0)
 s @rpt@($o(@rpt@(" "),-1)+1)=$g(ln)
"RTN","SAMIMOV",301,0)
 ;w !,ln
"RTN","SAMIMOV",302,0)
 q
"RTN","SAMIMOV",303,0)
 ;
"VER")
8.0^22.2
**END**
**END**
