Index: /EDIS/trunk/kids/UJO_0100_seq001_pat123.kids
===================================================================
--- /EDIS/trunk/kids/UJO_0100_seq001_pat123.kids	(revision 1340)
+++ /EDIS/trunk/kids/UJO_0100_seq001_pat123.kids	(revision 1340)
@@ -0,0 +1,1066 @@
+KIDS Distribution saved on Dec 26, 2011@16:58:31
+EDIS & VL fixes
+**KIDS**:UJO*1.0*123^
+
+**INSTALL NAME**
+UJO*1.0*123
+"BLD",8018,0)
+UJO*1.0*123^JORDAN SPECIFIC MODIFICATIONS^0^3111226^n
+"BLD",8018,1,0)
+^^10^10^3111226^
+"BLD",8018,1,1,0)
+mainly this patch will fix different issues in the attached EDIS and 
+"BLD",8018,1,2,0)
+VistALink routines, which falls in the following criteria.
+"BLD",8018,1,3,0)
+ 
+"BLD",8018,1,4,0)
+1- relational operators that GT.M can not compile like using of ">=", 
+"BLD",8018,1,5,0)
+GT.M can handle single operator at the time.
+"BLD",8018,1,6,0)
+which exists in EDPRPT5, EDPRPTBV, EDPYPRE routines.
+"BLD",8018,1,7,0)
+ 
+"BLD",8018,1,8,0)
+2- authentication problem, which cause lose of RPC parameters in 
+"BLD",8018,1,9,0)
+VistALink in XOBSRA1 routine, New'ing the RPC parameters will preserve 
+"BLD",8018,1,10,0)
+the Value of those parameters.
+"BLD",8018,4,0)
+^9.64PA^^
+"BLD",8018,6.3)
+6
+"BLD",8018,"KRN",0)
+^9.67PA^779.2^20
+"BLD",8018,"KRN",.4,0)
+.4
+"BLD",8018,"KRN",.401,0)
+.401
+"BLD",8018,"KRN",.402,0)
+.402
+"BLD",8018,"KRN",.403,0)
+.403
+"BLD",8018,"KRN",.5,0)
+.5
+"BLD",8018,"KRN",.84,0)
+.84
+"BLD",8018,"KRN",3.6,0)
+3.6
+"BLD",8018,"KRN",3.8,0)
+3.8
+"BLD",8018,"KRN",9.2,0)
+9.2
+"BLD",8018,"KRN",9.8,0)
+9.8
+"BLD",8018,"KRN",9.8,"NM",0)
+^9.68A^5^4
+"BLD",8018,"KRN",9.8,"NM",2,0)
+EDPRPTBV^^0^B22104348
+"BLD",8018,"KRN",9.8,"NM",3,0)
+EDPRPT5^^0^B36687959
+"BLD",8018,"KRN",9.8,"NM",4,0)
+EDPYPRE^^0^B9222306
+"BLD",8018,"KRN",9.8,"NM",5,0)
+XOBSRA1^^0^B4031966
+"BLD",8018,"KRN",9.8,"NM","B","EDPRPT5",3)
+
+"BLD",8018,"KRN",9.8,"NM","B","EDPRPTBV",2)
+
+"BLD",8018,"KRN",9.8,"NM","B","EDPYPRE",4)
+
+"BLD",8018,"KRN",9.8,"NM","B","XOBSRA1",5)
+
+"BLD",8018,"KRN",19,0)
+19
+"BLD",8018,"KRN",19.1,0)
+19.1
+"BLD",8018,"KRN",101,0)
+101
+"BLD",8018,"KRN",409.61,0)
+409.61
+"BLD",8018,"KRN",771,0)
+771
+"BLD",8018,"KRN",779.2,0)
+779.2
+"BLD",8018,"KRN",870,0)
+870
+"BLD",8018,"KRN",8989.51,0)
+8989.51
+"BLD",8018,"KRN",8989.52,0)
+8989.52
+"BLD",8018,"KRN",8994,0)
+8994
+"BLD",8018,"KRN","B",.4,.4)
+
+"BLD",8018,"KRN","B",.401,.401)
+
+"BLD",8018,"KRN","B",.402,.402)
+
+"BLD",8018,"KRN","B",.403,.403)
+
+"BLD",8018,"KRN","B",.5,.5)
+
+"BLD",8018,"KRN","B",.84,.84)
+
+"BLD",8018,"KRN","B",3.6,3.6)
+
+"BLD",8018,"KRN","B",3.8,3.8)
+
+"BLD",8018,"KRN","B",9.2,9.2)
+
+"BLD",8018,"KRN","B",9.8,9.8)
+
+"BLD",8018,"KRN","B",19,19)
+
+"BLD",8018,"KRN","B",19.1,19.1)
+
+"BLD",8018,"KRN","B",101,101)
+
+"BLD",8018,"KRN","B",409.61,409.61)
+
+"BLD",8018,"KRN","B",771,771)
+
+"BLD",8018,"KRN","B",779.2,779.2)
+
+"BLD",8018,"KRN","B",870,870)
+
+"BLD",8018,"KRN","B",8989.51,8989.51)
+
+"BLD",8018,"KRN","B",8989.52,8989.52)
+
+"BLD",8018,"KRN","B",8994,8994)
+
+"BLD",8018,"QUES",0)
+^9.62^^
+"BLD",8018,"REQB",0)
+^9.611^1^1
+"BLD",8018,"REQB",1,0)
+EMERGENCY DEPARTMENT 1.0^1
+"BLD",8018,"REQB","B","EMERGENCY DEPARTMENT 1.0",1)
+
+"MBREQ")
+0
+"PKG",209,-1)
+1^1
+"PKG",209,0)
+JORDAN SPECIFIC MODIFICATIONS^UJO
+"PKG",209,20,0)
+^9.402P^^
+"PKG",209,22,0)
+^9.49I^1^1
+"PKG",209,22,1,0)
+1.0
+"PKG",209,22,1,"PAH",1,0)
+123^3111226^8
+"PKG",209,22,1,"PAH",1,1,0)
+^^10^10^3111226
+"PKG",209,22,1,"PAH",1,1,1,0)
+mainly this patch will fix different issues in the attached EDIS and 
+"PKG",209,22,1,"PAH",1,1,2,0)
+VistALink routines, which falls in the following criteria.
+"PKG",209,22,1,"PAH",1,1,3,0)
+ 
+"PKG",209,22,1,"PAH",1,1,4,0)
+1- relational operators that GT.M can not compile like using of ">=", 
+"PKG",209,22,1,"PAH",1,1,5,0)
+GT.M can handle single operator at the time.
+"PKG",209,22,1,"PAH",1,1,6,0)
+which exists in EDPRPT5, EDPRPTBV, EDPYPRE routines.
+"PKG",209,22,1,"PAH",1,1,7,0)
+ 
+"PKG",209,22,1,"PAH",1,1,8,0)
+2- authentication problem, which cause lose of RPC parameters in 
+"PKG",209,22,1,"PAH",1,1,9,0)
+VistALink in XOBSRA1 routine, New'ing the RPC parameters will preserve 
+"PKG",209,22,1,"PAH",1,1,10,0)
+the Value of those parameters.
+"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")
+4
+"RTN","EDPRPT5")
+0^3^B36687959
+"RTN","EDPRPT5",1,0)
+EDPRPT5 ;SLC/MKB - Shift Report
+"RTN","EDPRPT5",2,0)
+ ;;1.0;EMERGENCY DEPARTMENT;;Sep 30, 2009;Build 6
+"RTN","EDPRPT5",3,0)
+ ;
+"RTN","EDPRPT5",4,0)
+SFT(DAY) ; Get Shift Report for EDPSITE on DAY
+"RTN","EDPRPT5",5,0)
+ N BEG,END,IN,OUT,LOG,X,X0,X1,X3,X4,S,SOUT,SHIFT
+"RTN","EDPRPT5",6,0)
+ N CNT,VA,DX,OTH,HR6,TRG,OCB,MO,DIE,UNK,PREV,NEXT,SUB
+"RTN","EDPRPT5",7,0)
+ N ELAPSE,ADMDEC,STS,DISP,COL
+"RTN","EDPRPT5",8,0)
+ D INIT ;set counters to 0, SHIFT(#) = start time in seconds
+"RTN","EDPRPT5",9,0)
+ I 'SHIFT D ERR^EDPRPT(2300013) Q
+"RTN","EDPRPT5",10,0)
+ S BEG=$S(SHIFT(1)>0:$$FMADD^XLFDT(DAY,-1,,,SHIFT(SHIFT)),1:DAY)
+"RTN","EDPRPT5",11,0)
+ S END=$S(SHIFT(1)>0:$$FMADD^XLFDT(DAY,,,,SHIFT(SHIFT)),1:DAY_".2359")
+"RTN","EDPRPT5",12,0)
+ S IN=BEG-.000001 F  S IN=$O(^EDP(230,"ATI",EDPSITE,IN)) Q:'IN  Q:IN>END  D
+"RTN","EDPRPT5",13,0)
+ . S LOG=0 F  S LOG=+$O(^EDP(230,"ATI",EDPSITE,IN,LOG)) Q:LOG<1  D
+"RTN","EDPRPT5",14,0)
+ .. S X0=^EDP(230,LOG,0),X1=$G(^(1)),X3=$G(^(3)),X4=$G(^(4,1,0))
+"RTN","EDPRPT5",15,0)
+ .. S STS=$$ECODE^EDPRPT($P(X3,U,2))
+"RTN","EDPRPT5",16,0)
+ .. S DISP=$$ECODE^EDPRPT($P(X1,U,2)),DISP=$$UP^XLFSTR(DISP)
+"RTN","EDPRPT5",17,0)
+ .. S OUT=$P(X0,U,9) ;S:OUT="" OUT=NOW
+"RTN","EDPRPT5",18,0)
+ .. S ELAPSE=$S(OUT:($$FMDIFF^XLFDT(OUT,IN,2)\60),1:0) ;#min
+"RTN","EDPRPT5",19,0)
+ .. S ADMDEC=$$ADMIT^EDPRPT(LOG)
+"RTN","EDPRPT5",20,0)
+D1 .. ; all visits
+"RTN","EDPRPT5",21,0)
+ .. S S=$$SHIFT(IN,1),SOUT=$$SHIFT(OUT,1)
+"RTN","EDPRPT5",22,0)
+ .. S CNT(S)=CNT(S)+1
+"RTN","EDPRPT5",23,0)
+ .. S:'$P(X3,U,3) TRG(S)=TRG(S)+1
+"RTN","EDPRPT5",24,0)
+ .. S:ELAPSE>359 HR6(S)=HR6(S)+1
+"RTN","EDPRPT5",25,0)
+ .. S:DISP="O"!(DISP="NVA") OTH(S)=OTH(S)+1
+"RTN","EDPRPT5",26,0)
+ .. S:DISP="D" DIE(S)=DIE(S)+1
+"RTN","EDPRPT5",27,0)
+ .. S:$$MISSEDOP^EDPRPT3(DISP) MO(S)=MO(S)+1
+"RTN","EDPRPT5",28,0)
+ .. S:DISP="" UNK(S)=UNK(S)+1
+"RTN","EDPRPT5",29,0)
+ .. I $L(STS),$$UP^XLFSTR(STS)'="GONE",S'=SOUT S OCB(S)=OCB(S)+1
+"RTN","EDPRPT5",30,0)
+D2 S OUT=BEG-.000001 F  S OUT=$O(^EDP(230,"ATO",EDPSITE,OUT)) Q:'OUT  Q:OUT>END  D
+"RTN","EDPRPT5",31,0)
+ . S LOG=0 F  S LOG=+$O(^EDP(230,"ATO",EDPSITE,OUT,LOG)) Q:LOG<1  D
+"RTN","EDPRPT5",32,0)
+ .. S X0=^EDP(230,LOG,0),X1=$G(^(1))
+"RTN","EDPRPT5",33,0)
+ .. S SOUT=$$SHIFT(OUT,1),DX(SOUT)=DX(SOUT)+1
+"RTN","EDPRPT5",34,0)
+ .. S IN=$P(X0,U,8) S:IN<BEG PREV=PREV+1
+"RTN","EDPRPT5",35,0)
+ .. S DISP=$$ECODE^EDPRPT($P(X1,U,2))
+"RTN","EDPRPT5",36,0)
+ .. S ADMDEC=$$ADMIT^EDPRPT(LOG)
+"RTN","EDPRPT5",37,0)
+ .. I ADMDEC,ADMDEC>BEG,$$VADMIT^EDPRPT2(DISP) S S=$$SHIFT(ADMDEC,1),VA(S)=VA(S)+1
+"RTN","EDPRPT5",38,0)
+D3 ; calculate #carried over
+"RTN","EDPRPT5",39,0)
+ S S=SUB(SHIFT),NEXT(S)=PREV+CNT(S)-DX(S)
+"RTN","EDPRPT5",40,0)
+ S PREV("one")=NEXT(S),PREV(S)=PREV
+"RTN","EDPRPT5",41,0)
+ F I=1:1:(SHIFT-1) S S=SUB(I),X=SUB($S(I>1:I-1,1:SHIFT)),NEXT(S)=NEXT(X)+CNT(S)-DX(S)
+"RTN","EDPRPT5",42,0)
+ F I=2:1:(SHIFT-1) S PREV(SUB(I))=NEXT(SUB(I-1))
+"RTN","EDPRPT5",43,0)
+ ;S NEXT("three")=PREV+CNT("three")-DX("three")
+"RTN","EDPRPT5",44,0)
+ ;S NEXT("one")=NEXT("three")+CNT("one")-DX("one")
+"RTN","EDPRPT5",45,0)
+ ;S NEXT("two")=NEXT("one")+CNT("two")-DX("two")
+"RTN","EDPRPT5",46,0)
+ ;S PREV("one")=NEXT("three"),PREV("two")=NEXT("one"),PREV("three")=PREV
+"RTN","EDPRPT5",47,0)
+D4 ; return column info
+"RTN","EDPRPT5",48,0)
+ F I=1:1:SHIFT D  ;convert #seconds to HH[:MM]
+"RTN","EDPRPT5",49,0)
+ . N X,Y S X=SHIFT(I),Y=X\60
+"RTN","EDPRPT5",50,0)
+ . ;S Y=X\3600 S:Y=0 Y=12 S:Y>12 Y=Y-12
+"RTN","EDPRPT5",51,0)
+ . S SHIFT(I)=$$ETIME^EDPRPT(Y) ;Y_$S(X#3600:":"_(X#3600)\60,1:"")
+"RTN","EDPRPT5",52,0)
+ F I=1:1:SHIFT D  ;build column captions
+"RTN","EDPRPT5",53,0)
+ . S COL(I,"name")=SHIFT(I)_" to "_SHIFT($S(I+1>SHIFT:1,1:I+1))
+"RTN","EDPRPT5",54,0)
+ . S COL(I,"shiftId")=SUB(I)
+"RTN","EDPRPT5",55,0)
+ ;S COL(1,"name")="7 to 3",COL(1,"shiftId")="one"
+"RTN","EDPRPT5",56,0)
+ ;S COL(2,"name")="3 to 11",COL(2,"shiftId")="two"
+"RTN","EDPRPT5",57,0)
+ ;S COL(3,"name")="11 to 7",COL(3,"shiftId")="three"
+"RTN","EDPRPT5",58,0)
+ I $G(CSV) D CSV Q
+"RTN","EDPRPT5",59,0)
+ D XML^EDPX("<columns>")
+"RTN","EDPRPT5",60,0)
+ F S=1:1:SHIFT K X M X=COL(S) S X=$$XMLA^EDPX("column",.X) D XML^EDPX(X)
+"RTN","EDPRPT5",61,0)
+ D XML^EDPX("</columns>")
+"RTN","EDPRPT5",62,0)
+D5 ; return counts and averages as XML
+"RTN","EDPRPT5",63,0)
+ D XML^EDPX("<categories>")
+"RTN","EDPRPT5",64,0)
+ S X=$$XMLA^EDPX("category",.PREV) D XML^EDPX(X)
+"RTN","EDPRPT5",65,0)
+ S X=$$XMLA^EDPX("category",.CNT) D XML^EDPX(X)
+"RTN","EDPRPT5",66,0)
+ S X=$$XMLA^EDPX("category",.DX) D XML^EDPX(X)
+"RTN","EDPRPT5",67,0)
+ S X=$$XMLA^EDPX("category",.VA) D XML^EDPX(X)
+"RTN","EDPRPT5",68,0)
+ S X=$$XMLA^EDPX("category",.OTH) D XML^EDPX(X)
+"RTN","EDPRPT5",69,0)
+ S X=$$XMLA^EDPX("category",.HR6) D XML^EDPX(X)
+"RTN","EDPRPT5",70,0)
+ S X=$$XMLA^EDPX("category",.TRG) D XML^EDPX(X)
+"RTN","EDPRPT5",71,0)
+ S X=$$XMLA^EDPX("category",.OCB) D XML^EDPX(X)
+"RTN","EDPRPT5",72,0)
+ S X=$$XMLA^EDPX("category",.MO) D XML^EDPX(X)
+"RTN","EDPRPT5",73,0)
+ S X=$$XMLA^EDPX("category",.DIE) D XML^EDPX(X)
+"RTN","EDPRPT5",74,0)
+ S X=$$XMLA^EDPX("category",.UNK) D XML^EDPX(X)
+"RTN","EDPRPT5",75,0)
+ S X=$$XMLA^EDPX("category",.NEXT) D XML^EDPX(X)
+"RTN","EDPRPT5",76,0)
+ D XML^EDPX("</categories>")
+"RTN","EDPRPT5",77,0)
+ Q
+"RTN","EDPRPT5",78,0)
+ ;
+"RTN","EDPRPT5",79,0)
+CSV ; Return headers, counts and averages as CSV
+"RTN","EDPRPT5",80,0)
+ N X,TAB S TAB=$C(9)
+"RTN","EDPRPT5",81,0)
+ S X="Category"_TAB_COL(SHIFT,"name")
+"RTN","EDPRPT5",82,0)
+ F I=1:1:(SHIFT-1) S X=X_TAB_COL(I,"name")
+"RTN","EDPRPT5",83,0)
+ D ADD^EDPCSV(X) ;headers
+"RTN","EDPRPT5",84,0)
+ D ROW("Carried over at Report Start",.PREV)
+"RTN","EDPRPT5",85,0)
+ D ROW("Number of New Patients",.CNT)
+"RTN","EDPRPT5",86,0)
+ D ROW("Number of Patients Discharged",.DX)
+"RTN","EDPRPT5",87,0)
+ D ROW("Number Dec to Admit to VA",.VA)
+"RTN","EDPRPT5",88,0)
+ D ROW("Number Dec to Admit to Other",.OTH)
+"RTN","EDPRPT5",89,0)
+ D ROW("Number over Six Hours",.HR6)
+"RTN","EDPRPT5",90,0)
+ D ROW("Number Waiting for Triage",.TRG)
+"RTN","EDPRPT5",91,0)
+ D ROW("Number of Occupied Beds",.OCB)
+"RTN","EDPRPT5",92,0)
+ D ROW("Number of Missed Opportunities",.MO)
+"RTN","EDPRPT5",93,0)
+ D ROW("Number Deceased",.DIE)
+"RTN","EDPRPT5",94,0)
+ D ROW("Number With No Disposition",.UNK)
+"RTN","EDPRPT5",95,0)
+ D ROW("Carry over to Next Shift",.NEXT)
+"RTN","EDPRPT5",96,0)
+ Q
+"RTN","EDPRPT5",97,0)
+ ;
+"RTN","EDPRPT5",98,0)
+ROW(NAME,LIST) ; add row
+"RTN","EDPRPT5",99,0)
+ N S,I
+"RTN","EDPRPT5",100,0)
+ S S=SUB(SHIFT),X=NAME_TAB_LIST(S)
+"RTN","EDPRPT5",101,0)
+ F I=1:1:(SHIFT-1) S S=SUB(I),X=X_TAB_LIST(S)
+"RTN","EDPRPT5",102,0)
+ D ADD^EDPCSV(X)
+"RTN","EDPRPT5",103,0)
+ Q
+"RTN","EDPRPT5",104,0)
+ ;
+"RTN","EDPRPT5",105,0)
+INIT ; Initialize counters and sums
+"RTN","EDPRPT5",106,0)
+ N I,S
+"RTN","EDPRPT5",107,0)
+ S PREV=0,DAY=$P(DAY,".")
+"RTN","EDPRPT5",108,0)
+ D SETUP F I=1:1:SHIFT D
+"RTN","EDPRPT5",109,0)
+ . S S=$$WORD(I),SUB(I)=S
+"RTN","EDPRPT5",110,0)
+ . S CNT(S)=0,CNT("category")="Number of New Patients"
+"RTN","EDPRPT5",111,0)
+ . S DX(S)=0,DX("category")="Number of Patients Discharged"
+"RTN","EDPRPT5",112,0)
+ . S VA(S)=0,VA("category")="Number Dec to Admit to VA"
+"RTN","EDPRPT5",113,0)
+ . S OTH(S)=0,OTH("category")="Number Dec to Admit to Other"
+"RTN","EDPRPT5",114,0)
+ . S HR6(S)=0,HR6("category")="Number over Six Hours"
+"RTN","EDPRPT5",115,0)
+ . S TRG(S)=0,TRG("category")="Number Waiting for Triage" ;no acuity
+"RTN","EDPRPT5",116,0)
+ . S OCB(S)=0,OCB("category")="Number of Occupied Beds"
+"RTN","EDPRPT5",117,0)
+ . S MO(S)=0,MO("category")="Number of Missed Opportunities"
+"RTN","EDPRPT5",118,0)
+ . S DIE(S)=0,DIE("category")="Number Deceased"
+"RTN","EDPRPT5",119,0)
+ . S UNK(S)=0,UNK("category")="Number With No Disposition"
+"RTN","EDPRPT5",120,0)
+ . S PREV(S)=0,PREV("category")="Carried over at Report Start"
+"RTN","EDPRPT5",121,0)
+ . S NEXT(S)=0,NEXT("category")="Carry over to Next Shift"
+"RTN","EDPRPT5",122,0)
+ Q
+"RTN","EDPRPT5",123,0)
+ ;
+"RTN","EDPRPT5",124,0)
+WORD(X) ; Return name of number X
+"RTN","EDPRPT5",125,0)
+ N Y S Y=$S(X=1:"one",X=2:"two",X=3:"three",X=4:"four",X=5:"five",X=6:"six",X=7:"seven",X=8:"eight",X=9:"nine",X=10:"ten",X=11:"eleven",X=12:"twelve",1:"none")
+"RTN","EDPRPT5",126,0)
+ Q Y
+"RTN","EDPRPT5",127,0)
+ ;
+"RTN","EDPRPT5",128,0)
+SETUP ; Create SHIFT(#) list of shift times
+"RTN","EDPRPT5",129,0)
+ N TA,X1,X,DUR
+"RTN","EDPRPT5",130,0)
+ S TA=+$O(^EDPB(231.9,"C",EDPSITE,0)),X1=$G(^EDPB(231.9,TA,1))
+"RTN","EDPRPT5",131,0)
+ S X=$P(X1,U,6),DUR=$P(X1,U,7)*60 I DUR'>0 S SHIFT=0 Q
+"RTN","EDPRPT5",132,0)
+ S SHIFT=1,SHIFT(1)=X*60 ;seconds
+"RTN","EDPRPT5",133,0)
+ F  S X=SHIFT(SHIFT)+DUR Q:X>86340  S SHIFT=SHIFT+1,SHIFT(SHIFT)=X
+"RTN","EDPRPT5",134,0)
+ Q
+"RTN","EDPRPT5",135,0)
+ ;
+"RTN","EDPRPT5",136,0)
+SHIFT(X,TXT) ; Return shift # for time X using SHIFT(#)
+"RTN","EDPRPT5",137,0)
+ I $G(X)="" Q 0
+"RTN","EDPRPT5",138,0)
+ N TM,Y
+"RTN","EDPRPT5",139,0)
+ S TM=$P($$FMTH^XLFDT(X),",",2) ;#seconds since midnight
+"RTN","EDPRPT5",140,0)
+ ;;UJO/AS fix mathematical expressions that GT.M can not compile
+"RTN","EDPRPT5",141,0)
+ ;I TM<SHIFT(1)!(TM>=SHIFT(SHIFT)) S Y=SHIFT
+"RTN","EDPRPT5",142,0)
+ ;;
+"RTN","EDPRPT5",143,0)
+ I TM<SHIFT(1)!((TM>SHIFT(SHIFT))!(TM=SHIFT(SHIFT))) S Y=SHIFT
+"RTN","EDPRPT5",144,0)
+ E  F I=2:1:SHIFT I TM<SHIFT(I) S Y=I-1 Q
+"RTN","EDPRPT5",145,0)
+ S:$G(TXT) Y=$$WORD(Y)
+"RTN","EDPRPT5",146,0)
+ ;S Y=$S(TM<25200:"three",TM<54000:"one",TM<82800:"two",1:"three")
+"RTN","EDPRPT5",147,0)
+ Q Y
+"RTN","EDPRPT5",148,0)
+ ;
+"RTN","EDPRPT5",149,0)
+ECODE(IEN) ; Return external value for an Acuity code
+"RTN","EDPRPT5",150,0)
+ N X,Y S X=$P($G(^EDPB(233.1,IEN,0)),U,3) ;code
+"RTN","EDPRPT5",151,0)
+ S Y=$S(X="":"none",'X:X,X=1:"one",X=2:"two",X=3:"three",X=4:"four",X=5:"five",1:"X")
+"RTN","EDPRPT5",152,0)
+ Q Y
+"RTN","EDPRPTBV")
+0^2^B22104348
+"RTN","EDPRPTBV",1,0)
+EDPRPTBV ;SLC/MKB - BVAC Report
+"RTN","EDPRPTBV",2,0)
+ ;;1.0;EMERGENCY DEPARTMENT;;Sep 30, 2009;Build 6
+"RTN","EDPRPTBV",3,0)
+ ;
+"RTN","EDPRPTBV",4,0)
+EN(BEG,END) ; Get Activity Report for EDPSITE by date range
+"RTN","EDPRPTBV",5,0)
+ N LOG,X,X0,X1,X3,DX,IN,OUT,ROW,ICD,I
+"RTN","EDPRPTBV",6,0)
+ N ELAPSE,TRIAGE,ADMDEC,ADMDEL,CNT,ADM,MIN,AVG
+"RTN","EDPRPTBV",7,0)
+ D INIT ;set counters, sums to 0
+"RTN","EDPRPTBV",8,0)
+ D:'$G(CSV) XML^EDPX("<logEntries>") I $G(CSV) D  ;headers
+"RTN","EDPRPTBV",9,0)
+ . N TAB S TAB=$C(9)
+"RTN","EDPRPTBV",10,0)
+ . S X="Patient"_TAB_"Time In"_TAB_"Time Out"_TAB_"Complaint"_TAB_"MD"_TAB_"Acuity"_TAB_"Elapsed"_TAB_"Triage"_TAB_"Dispo"_TAB_"Admit Dec"_TAB_"Admit Delay"_TAB_"Diagnosis"_TAB_"ICD9"
+"RTN","EDPRPTBV",11,0)
+ . S X=X_TAB_"Viet Vet"_TAB_"Agent Orange"_TAB_"OEF/OIF"_TAB_"Pers Gulf"_TAB_"VA Pension"_TAB_"POW"_TAB_"Serv Conn %"_TAB_"Purp Hrt"_TAB_"Unemploy"_TAB_"Combat End"
+"RTN","EDPRPTBV",12,0)
+ . D ADD^EDPCSV(X)
+"RTN","EDPRPTBV",13,0)
+ S IN=BEG-.000001
+"RTN","EDPRPTBV",14,0)
+ F  S IN=$O(^EDP(230,"ATI",EDPSITE,IN)) Q:'IN  Q:IN>END  S LOG=0 F  S LOG=+$O(^EDP(230,"ATI",EDPSITE,IN,LOG)) Q:LOG<1  D
+"RTN","EDPRPTBV",15,0)
+ . S X0=^EDP(230,LOG,0),X1=$G(^(1)),X3=$G(^(3))
+"RTN","EDPRPTBV",16,0)
+ . S DX=$$BVAC(+$P(X0,U,3),LOG) Q:DX=""  ;no codes in range
+"RTN","EDPRPTBV",17,0)
+ . S CNT=CNT+1,OUT=$P(X0,U,9) ;S:OUT="" OUT=NOW
+"RTN","EDPRPTBV",18,0)
+ . S ELAPSE=$S(OUT:($$FMDIFF^XLFDT(OUT,IN,2)\60),1:0)
+"RTN","EDPRPTBV",19,0)
+ . S MIN("elapsed")=MIN("elapsed")+ELAPSE
+"RTN","EDPRPTBV",20,0)
+ . S X=$$ACUITY^EDPRPT(LOG),TRIAGE=0 ;S:X<1 X=OUT
+"RTN","EDPRPTBV",21,0)
+ . S:X TRIAGE=($$FMDIFF^XLFDT(X,IN,2)\60)
+"RTN","EDPRPTBV",22,0)
+ . S MIN("triage")=MIN("triage")+TRIAGE
+"RTN","EDPRPTBV",23,0)
+ . S (ADMDEC,ADMDEL)=""
+"RTN","EDPRPTBV",24,0)
+ . S X=$$ADMIT^EDPRPT(LOG) I X S ADM=ADM+1 D   ;decision to admit
+"RTN","EDPRPTBV",25,0)
+ .. S ADMDEC=($$FMDIFF^XLFDT(X,IN,2)\60)
+"RTN","EDPRPTBV",26,0)
+ .. S ADMDEL=$S(OUT:($$FMDIFF^XLFDT(OUT,X,2)\60),1:0)
+"RTN","EDPRPTBV",27,0)
+ .. S MIN("admDec")=MIN("admDec")+ADMDEC
+"RTN","EDPRPTBV",28,0)
+ .. S MIN("admDel")=MIN("admDel")+ADMDEL
+"RTN","EDPRPTBV",29,0)
+ . ;
+"RTN","EDPRPTBV",30,0)
+BV1 . ; add row to report
+"RTN","EDPRPTBV",31,0)
+ . ;S ICD=$P($G(^ICD9(+$P(X4,U,2),0)),U) Q:ICD<290  Q:ICD>316
+"RTN","EDPRPTBV",32,0)
+ . K ROW S ROW("patient")=$P(X0,U,4)
+"RTN","EDPRPTBV",33,0)
+ . S ROW("inTS")=$S($G(CSV):$$EDATE^EDPRPT(IN),1:IN)
+"RTN","EDPRPTBV",34,0)
+ . S ROW("outTS")=$S($G(CSV):$$EDATE^EDPRPT(OUT),1:OUT)
+"RTN","EDPRPTBV",35,0)
+ . S ROW("complaint")=$P(X1,U)
+"RTN","EDPRPTBV",36,0)
+ . S ROW("md")=$$EPERS^EDPRPT($P(X3,U,5))
+"RTN","EDPRPTBV",37,0)
+ . S ROW("acuity")=$$ECODE^EDPRPT($P(X3,U,3))
+"RTN","EDPRPTBV",38,0)
+ . S ROW("elapsed")=ELAPSE_$S(ELAPSE>359:" *",1:"")
+"RTN","EDPRPTBV",39,0)
+ . S ROW("triage")=TRIAGE
+"RTN","EDPRPTBV",40,0)
+ . S ROW("disposition")=$$ECODE^EDPRPT($P(X1,U,2))
+"RTN","EDPRPTBV",41,0)
+ . S ROW("admDec")=ADMDEC,ROW("admDel")=ADMDEL
+"RTN","EDPRPTBV",42,0)
+ . S ROW("icd")=$P(DX,U),ROW("dx")=$P(DX,U,2)
+"RTN","EDPRPTBV",43,0)
+ . ; get other patient attributes from VADPT
+"RTN","EDPRPTBV",44,0)
+ . N DFN,VAEL,VASV,VAMB,VAERR
+"RTN","EDPRPTBV",45,0)
+ . S DFN=$P(X0,U,6) I DFN D 8^VADPT D
+"RTN","EDPRPTBV",46,0)
+ .. S ROW("vietnam")=$S(VASV(1):"Y",1:"N")
+"RTN","EDPRPTBV",47,0)
+ .. S ROW("agentOrange")=$S(VASV(2):"Y",1:"N")
+"RTN","EDPRPTBV",48,0)
+ .. S ROW("iraq")=$S(VASV(11)!VASV(12)!VASV(13):"Y",1:"N")
+"RTN","EDPRPTBV",49,0)
+ .. S ROW("persGulf")=$P($G(^DPT(DFN,.322)),U,10)
+"RTN","EDPRPTBV",50,0)
+ .. S ROW("vaPension")=$S(VAMB(4):"Y",1:"N")
+"RTN","EDPRPTBV",51,0)
+ .. S ROW("pow")=$S(VASV(4):"Y",1:"N")
+"RTN","EDPRPTBV",52,0)
+ .. S ROW("servConnPct")=+$P(VAEL(3),U,2)
+"RTN","EDPRPTBV",53,0)
+ .. S ROW("purpleHeart")=$S(VASV(9):"Y",1:"N")
+"RTN","EDPRPTBV",54,0)
+ .. ; ROW("unemployable")=$P($G(^DGEN(27.11,DFN,"E")),U,17) ;or VAPD(7)=3^NOT EMPLOYED ??
+"RTN","EDPRPTBV",55,0)
+ .. S ROW("combatEndDT")=$P($G(VASV(10,1)),U)
+"RTN","EDPRPTBV",56,0)
+BV2 . ;
+"RTN","EDPRPTBV",57,0)
+ . I '$G(CSV) S X=$$XMLA^EDPX("log",.ROW) D XML^EDPX(X) Q
+"RTN","EDPRPTBV",58,0)
+ . S X=ROW("patient")
+"RTN","EDPRPTBV",59,0)
+ . F I="inTS","outTS","complaint","md","acuity","elapsed","triage","disposition","admDec","admDel","dx","icd" S X=X_$C(9)_$G(ROW(I))
+"RTN","EDPRPTBV",60,0)
+ . F I="vietnam","agentOrange","iraq","persGulf","vaPension","pow","servConn%","purpleHeart","unemployable","combatEndDT" S X=X_$C(9)_$G(ROW(I))
+"RTN","EDPRPTBV",61,0)
+ . D ADD^EDPCSV(X)
+"RTN","EDPRPTBV",62,0)
+ D:'$G(CSV) XML^EDPX("</logEntries>")
+"RTN","EDPRPTBV",63,0)
+ ;
+"RTN","EDPRPTBV",64,0)
+BV3 ; calculate & include averages
+"RTN","EDPRPTBV",65,0)
+ Q:CNT<1  ;no visits found
+"RTN","EDPRPTBV",66,0)
+ S ELAPSE=$$ETIME^EDPRPT(MIN("elapsed")\CNT),AVG("elapsed")=ELAPSE
+"RTN","EDPRPTBV",67,0)
+ S TRIAGE=$$ETIME^EDPRPT(MIN("triage")\CNT),AVG("triage")=TRIAGE
+"RTN","EDPRPTBV",68,0)
+ S ADMDEC=$S(ADM:$$ETIME^EDPRPT(MIN("admDec")\ADM),1:"00:00")
+"RTN","EDPRPTBV",69,0)
+ S ADMDEL=$S(ADM:$$ETIME^EDPRPT(MIN("admDel")\ADM),1:"00:00")
+"RTN","EDPRPTBV",70,0)
+ S AVG("admDec")=ADMDEC,AVG("admDel")=ADMDEL,AVG("total")=CNT
+"RTN","EDPRPTBV",71,0)
+ ;
+"RTN","EDPRPTBV",72,0)
+ I $G(CSV) D  Q  ;CSV format
+"RTN","EDPRPTBV",73,0)
+ . N TAB,D S TAB=$C(9)
+"RTN","EDPRPTBV",74,0)
+ . D BLANK^EDPCSV
+"RTN","EDPRPTBV",75,0)
+ . S X=TAB_"Total Patients"_TAB_CNT_TAB_"Averages Per Patient"_TAB_TAB_TAB_ELAPSE_TAB_TRIAGE_TAB_ADMDEC_TAB_ADMDEL
+"RTN","EDPRPTBV",76,0)
+ . D ADD^EDPCSV(X),BLANK^EDPCSV
+"RTN","EDPRPTBV",77,0)
+ D XML^EDPX("<averages>")
+"RTN","EDPRPTBV",78,0)
+ S X=$$XMLA^EDPX("average",.AVG) D XML^EDPX(X)
+"RTN","EDPRPTBV",79,0)
+ D XML^EDPX("</averages>")
+"RTN","EDPRPTBV",80,0)
+ Q
+"RTN","EDPRPTBV",81,0)
+ ;
+"RTN","EDPRPTBV",82,0)
+INIT ; Initialize counters and sums
+"RTN","EDPRPTBV",83,0)
+ N I,X S (CNT,ADM)=0
+"RTN","EDPRPTBV",84,0)
+ F I="elapsed","triage","admDec","admDel" S MIN(I)=0
+"RTN","EDPRPTBV",85,0)
+ Q
+"RTN","EDPRPTBV",86,0)
+ ;
+"RTN","EDPRPTBV",87,0)
+ECODE(IEN) ; Return external value for a Code
+"RTN","EDPRPTBV",88,0)
+ Q:IEN $P($G(^EDPB(233.1,IEN,0)),U,2) ;name
+"RTN","EDPRPTBV",89,0)
+ Q ""
+"RTN","EDPRPTBV",90,0)
+ ;
+"RTN","EDPRPTBV",91,0)
+BVAC(AREA,LOG) ; -- Return ICD^text of diagnosis in range, else null
+"RTN","EDPRPTBV",92,0)
+ N X,Y,I,EDPDX S Y=""
+"RTN","EDPRPTBV",93,0)
+ D DXALL^EDPQPCE(AREA,LOG,.EDPDX)
+"RTN","EDPRPTBV",94,0)
+ ;;UJO/AS fix mathematical expressions that GT.M can not compile
+"RTN","EDPRPTBV",95,0)
+ ; S I=0 F  S I=$O(EDPDX(I)) Q:I<1  S X=$G(EDPDX(I)) I 290<=+X,+X<=316 S Y=X Q
+"RTN","EDPRPTBV",96,0)
+ ;;
+"RTN","EDPRPTBV",97,0)
+ S I=0 F  S I=$O(EDPDX(I)) Q:I<1  S X=$G(EDPDX(I)) I ((290<+X)!(290=+X)),((+X<316)!(+X=316)) S Y=X Q
+"RTN","EDPRPTBV",98,0)
+ Q Y
+"RTN","EDPYPRE")
+0^4^B9222306
+"RTN","EDPYPRE",1,0)
+EDPYPRE ;SLC/KCM - Pre-init for facility install
+"RTN","EDPYPRE",2,0)
+ ;;1.0;EMERGENCY DEPARTMENT;;Sep 30, 2009;Build 6
+"RTN","EDPYPRE",3,0)
+ ;
+"RTN","EDPYPRE",4,0)
+ S ^TMP("EDP-LAST-VERSION")=+$P($$VERSRV,"1.0-T",2)
+"RTN","EDPYPRE",5,0)
+ ;
+"RTN","EDPYPRE",6,0)
+ D FIXT5,DELFLDS,DELCODES,CHGNAMES
+"RTN","EDPYPRE",7,0)
+ Q
+"RTN","EDPYPRE",8,0)
+ ;
+"RTN","EDPYPRE",9,0)
+DELFLDS ; delete obsolete fields
+"RTN","EDPYPRE",10,0)
+ I $$VERGTE(20) Q  ; only convert if version <20
+"RTN","EDPYPRE",11,0)
+ ;
+"RTN","EDPYPRE",12,0)
+ N DIK,DA
+"RTN","EDPYPRE",13,0)
+ I $D(^DD(230.1,1)) D
+"RTN","EDPYPRE",14,0)
+ . S DIK="^DD(230.1,",DA=1,DA(1)=230.1
+"RTN","EDPYPRE",15,0)
+ . D ^DIK
+"RTN","EDPYPRE",16,0)
+ I $D(^DD(231.9,.04)) D
+"RTN","EDPYPRE",17,0)
+ . S DIK="^DD(231.9,",DA=.04,DA(1)=231.9
+"RTN","EDPYPRE",18,0)
+ . D ^DIK
+"RTN","EDPYPRE",19,0)
+ Q
+"RTN","EDPYPRE",20,0)
+DELCODES ; delete site code sets
+"RTN","EDPYPRE",21,0)
+ I $$VERGTE(16) Q  ; only convert if version <16
+"RTN","EDPYPRE",22,0)
+ ;
+"RTN","EDPYPRE",23,0)
+ N X,DIK,DA
+"RTN","EDPYPRE",24,0)
+ S X="" F  S X=$O(^EDPB(233.2,"B",X)) Q:X=""  D
+"RTN","EDPYPRE",25,0)
+ . I $P(X,".")="edp" Q
+"RTN","EDPYPRE",26,0)
+ . S DA=$O(^EDPB(233.2,"B",X,0)) Q:'DA
+"RTN","EDPYPRE",27,0)
+ . S DIK="^EDPB(233.2,"
+"RTN","EDPYPRE",28,0)
+ . D ^DIK
+"RTN","EDPYPRE",29,0)
+ Q
+"RTN","EDPYPRE",30,0)
+CHGNAMES ; change code names
+"RTN","EDPYPRE",31,0)
+ I $$VERGTE(20) Q  ; only convert if version <20
+"RTN","EDPYPRE",32,0)
+ ;
+"RTN","EDPYPRE",33,0)
+ D CHG("edp.source.ambulance","zzedp.source.ambulance")
+"RTN","EDPYPRE",34,0)
+ D CHG("edp.source.code","zzedp.source.code")
+"RTN","EDPYPRE",35,0)
+ D CHG("edp.source.walk-in","zzedp.source.walk-in")
+"RTN","EDPYPRE",36,0)
+ D CHG("edp.source.cboc","edp.source.clinic-offsite")
+"RTN","EDPYPRE",37,0)
+ D CHG("edp.source.clinic","edp.source.clinic-onsite")
+"RTN","EDPYPRE",38,0)
+ D CHG("edp.source.nhcu","edp.source.nhcu-onsite")
+"RTN","EDPYPRE",39,0)
+ D CHG("edp.status.observation","zzedp.status.observation")
+"RTN","EDPYPRE",40,0)
+ D CHG("edp.status.overflow","zzedp.status.overflow")
+"RTN","EDPYPRE",41,0)
+ D CHG("edp.status.gone","zzedp.status.gone")
+"RTN","EDPYPRE",42,0)
+ D CHG("edp.delay.admitorders","edp.delay.admitdispo")
+"RTN","EDPYPRE",43,0)
+ Q
+"RTN","EDPYPRE",44,0)
+CHG(OLD,NEW) ; change old to new name
+"RTN","EDPYPRE",45,0)
+ Q:'$D(^EDPB(233.1,"B",OLD))
+"RTN","EDPYPRE",46,0)
+ N IEN
+"RTN","EDPYPRE",47,0)
+ S IEN=$O(^EDPB(233.1,"B",OLD,0)) Q:'IEN
+"RTN","EDPYPRE",48,0)
+ N FDA,DIERR
+"RTN","EDPYPRE",49,0)
+ S IEN=IEN_","
+"RTN","EDPYPRE",50,0)
+ S FDA(233.1,IEN,.01)=NEW
+"RTN","EDPYPRE",51,0)
+ D FILE^DIE("","FDA","ERR")
+"RTN","EDPYPRE",52,0)
+ D CLEAN^DILF
+"RTN","EDPYPRE",53,0)
+ Q
+"RTN","EDPYPRE",54,0)
+ ;
+"RTN","EDPYPRE",55,0)
+ ; VERSRV copied from EDPQAR to avoid $T(VERSRV^EDPQAR) error
+"RTN","EDPYPRE",56,0)
+ ;
+"RTN","EDPYPRE",57,0)
+VERSRV()   ; Return server version of option name
+"RTN","EDPYPRE",58,0)
+ N EDPLST,VAL
+"RTN","EDPYPRE",59,0)
+ D FIND^DIC(19,"",1,"X","EDPF TRACKING SYSTEM",1,,,,"EDPLST")
+"RTN","EDPYPRE",60,0)
+ S VAL=$G(EDPLST("DILIST","ID",1,1))
+"RTN","EDPYPRE",61,0)
+ S VAL=$P(VAL,"version ",2)
+"RTN","EDPYPRE",62,0)
+ I 'VAL Q "1.0T?"
+"RTN","EDPYPRE",63,0)
+ Q VAL
+"RTN","EDPYPRE",64,0)
+ ;
+"RTN","EDPYPRE",65,0)
+VERGTE(HIGH) ; Return 1 if existing version and greater than HIGH
+"RTN","EDPYPRE",66,0)
+ I $G(^TMP("EDP-LAST-VERSION"))<1 Q 1      ; no prior version
+"RTN","EDPYPRE",67,0)
+ ;;UJO/AS fix mathematical expressions that GT.M can not compile
+"RTN","EDPYPRE",68,0)
+ ;I $G(^TMP("EDP-LAST-VERSION"))>=HIGH Q 1  ; don't convert
+"RTN","EDPYPRE",69,0)
+ ;;
+"RTN","EDPYPRE",70,0)
+ I ($G(^TMP("EDP-LAST-VERSION"))>HIGH)!($G(^TMP("EDP-LAST-VERSION"))=HIGH) Q 1  ; don't convert
+"RTN","EDPYPRE",71,0)
+ Q 0                                       ; convert
+"RTN","EDPYPRE",72,0)
+ ;
+"RTN","EDPYPRE",73,0)
+FIXT5 ; convert the timezone offset to visit string
+"RTN","EDPYPRE",74,0)
+ ; (change occurred between T5 and T6)
+"RTN","EDPYPRE",75,0)
+ I $$VERGTE(6) Q  ; only convert if version <6
+"RTN","EDPYPRE",76,0)
+ ;
+"RTN","EDPYPRE",77,0)
+ N LOG,X0
+"RTN","EDPYPRE",78,0)
+ S LOG=0 F  S LOG=$O(^EDP(230,LOG)) Q:'LOG  D
+"RTN","EDPYPRE",79,0)
+ . S X0=^EDP(230,LOG,0)
+"RTN","EDPYPRE",80,0)
+ . I $P(X0,U,12)="0" S $P(^EDP(230,LOG,0),U,12)=""
+"RTN","EDPYPRE",81,0)
+ Q
+"RTN","EDPYPRE",82,0)
+ ;. To convert VSTR to VISIT
+"RTN","EDPYPRE",83,0)
+ ;. I $L($P(X0,U,12),";")=3 D
+"RTN","EDPYPRE",84,0)
+ ;.. N VSTR,VISIT,DFN,VISITIEN,I
+"RTN","EDPYPRE",85,0)
+ ;.. S VSTR=$P(X0,U,12),DFN=$P(X0,U,6)
+"RTN","EDPYPRE",86,0)
+ ;.. Q:'DFN
+"RTN","EDPYPRE",87,0)
+ ;.. K ^TMP("PXKENC",$J)
+"RTN","EDPYPRE",88,0)
+ ;.. S VISIT=+$$GETENC^PXAPI(DFN,$P(VSTR,";",2),$P(VSTR,";"))
+"RTN","EDPYPRE",89,0)
+ ;.. I VISIT<0 S $P(^EDP(230,LOG,0),U,12)="" Q
+"RTN","EDPYPRE",90,0)
+ ;.. S VISITIEN=""
+"RTN","EDPYPRE",91,0)
+ ;.. F I=1:1:$L(VISIT,U) I $P(^TMP("PXKENC",$J,$P(VISIT,U,I),"VST",$P(VISIT,U,I),0),U,6)=DUZ(2) S VISITIEN=$P(VISIT,U,I) Q
+"RTN","EDPYPRE",92,0)
+ ;.. S $P(^EDP(230,LOG,0),U,12)=VISITIEN
+"RTN","EDPYPRE",93,0)
+ Q
+"RTN","XOBSRA1")
+0^5^B4031966
+"RTN","XOBSRA1",1,0)
+XOBSRA1 ;mjk,esd/alb - VistALink Reauthentication Code ; 05/22/2003  07:00
+"RTN","XOBSRA1",2,0)
+ ;;1.5;VistALink Security;;Sep 09, 2005;Build 6
+"RTN","XOBSRA1",3,0)
+ ;;Foundations Toolbox Release v1.5 [Build: 1.5.0.026]
+"RTN","XOBSRA1",4,0)
+ ;
+"RTN","XOBSRA1",5,0)
+ QUIT
+"RTN","XOBSRA1",6,0)
+ ;
+"RTN","XOBSRA1",7,0)
+KILL ; -- clean up partition's local symbol table ; called from INIT^XOBSRA
+"RTN","XOBSRA1",8,0)
+ ;SET AAXOB="before" DO ^%ZTER ; -- used to view symbol table 'before' state
+"RTN","XOBSRA1",9,0)
+ ;
+"RTN","XOBSRA1",10,0)
+ IF XOBOS["OpenM" DO
+"RTN","XOBSRA1",11,0)
+ . ; -- Stack: CACHEVMS^XOBVTCP
+"RTN","XOBSRA1",12,0)
+ . ;           SPAWN^XOBVLL
+"RTN","XOBSRA1",13,0)
+ . ;           NXTCALL^XOBVLL
+"RTN","XOBSRA1",14,0)
+ . ;           EN^XOBVRM
+"RTN","XOBSRA1",15,0)
+ . ;           EN^XOBVRPC()
+"RTN","XOBSRA1",16,0)
+ . ;           SETUPDUZ^XOBSRA()
+"RTN","XOBSRA1",17,0)
+ . ;           
+"RTN","XOBSRA1",18,0)
+ . ; -- NEW non-XOB variables created in above stack
+"RTN","XOBSRA1",19,0)
+ . NEW DIQUIET,DX,DY,RPC0,RPCNAME,RPCIEN,TAG,ROU,METHSIG,XRTN
+"RTN","XOBSRA1",20,0)
+ . DO CACHE("XOB")
+"RTN","XOBSRA1",21,0)
+ ELSE  DO
+"RTN","XOBSRA1",22,0)
+ . DO OTHER
+"RTN","XOBSRA1",23,0)
+ ;
+"RTN","XOBSRA1",24,0)
+ ;SET AAXOB="after" DO ^%ZTER ; -- used to view symbol table 'after' state
+"RTN","XOBSRA1",25,0)
+ QUIT
+"RTN","XOBSRA1",26,0)
+ ;
+"RTN","XOBSRA1",27,0)
+CACHE(%NS) ; -- KILL all 'L'ocal 'VAR'iables except for a 'N'ame'S'pace (%NS) and Kernel for Cache systems
+"RTN","XOBSRA1",28,0)
+ NEW %LVAR,%NSLEN
+"RTN","XOBSRA1",29,0)
+ SET %NSLEN=$LENGTH(%NS)
+"RTN","XOBSRA1",30,0)
+ SET %LVAR=%NS
+"RTN","XOBSRA1",31,0)
+ FOR  SET %LVAR=$ORDER(@%LVAR) QUIT:%LVAR=""!($EXTRACT(%LVAR,1,%NSLEN)'=%NS)  NEW @%LVAR
+"RTN","XOBSRA1",32,0)
+ ; -- NEW Kernel variables and do the big KILL
+"RTN","XOBSRA1",33,0)
+ DO KILL^XUSCLEAN
+"RTN","XOBSRA1",34,0)
+ QUIT
+"RTN","XOBSRA1",35,0)
+ ;
+"RTN","XOBSRA1",36,0)
+OTHER ; -- explicit NEW'ing for other for non-Cache M implementations
+"RTN","XOBSRA1",37,0)
+ ; -- The following are NEW'ed as part KILL^XOBVLL call:
+"RTN","XOBSRA1",38,0)
+ ;    XOBPORT,XOBSTOP,XOBNULL,XOBOS,XOBSYS,XOBHDLR,XOBOK
+"RTN","XOBSRA1",39,0)
+ ; -- additional NEW'ing needed to preserve for CACHEVMS^XOBVTCP
+"RTN","XOBSRA1",40,0)
+ NEW XOBEC
+"RTN","XOBSRA1",41,0)
+ ; -- additional NEW'ing needed to preserve for SPAWN^XOBVLL
+"RTN","XOBSRA1",42,0)
+ NEW XOBLASTR
+"RTN","XOBSRA1",43,0)
+ ;;
+"RTN","XOBSRA1",44,0)
+ ;;EHS/AFS CHANGE START
+"RTN","XOBSRA1",45,0)
+ ;;additional NEW'ing needed to preserve RPC parameters
+"RTN","XOBSRA1",46,0)
+ FOR  SET I=$ORDER(XOBDATA("XOB RPC","PARAMS",I)) Q:I=""  NEW @XOBDATA("XOB RPC","PARAMS",I)
+"RTN","XOBSRA1",47,0)
+ ;;EHS/AFS CHANGE END
+"RTN","XOBSRA1",48,0)
+ ; -- additional NEW'ing needed to preserve for NXTCALL^XOBVLL
+"RTN","XOBSRA1",49,0)
+ NEW XOBROOT,XOBREAD,XOBTO,XOBFIRST,XOBDATA,DIQUIET
+"RTN","XOBSRA1",50,0)
+ ; -- additional NEW'ing needed to preserve for EN^XOBVRM
+"RTN","XOBSRA1",51,0)
+ NEW XOBOPT
+"RTN","XOBSRA1",52,0)
+ ; -- additional NEW'ing needed to preserve for EN^XOBVRPC()
+"RTN","XOBSRA1",53,0)
+ NEW DX,DY,RPC0,RPCNAME,RPCIEN,TAG,ROU,METHSIG,XOBERR,XOBR,XOBSEC,XOBWRAP,XRTN,XOBRA,XOBVER,XOBPTYPE
+"RTN","XOBSRA1",54,0)
+ ; -- additional NEW'ing needed to preserve for SETUPDUZ^XOBSRA()
+"RTN","XOBSRA1",55,0)
+ NEW XOBERR,XOBID,XOBTYPE
+"RTN","XOBSRA1",56,0)
+ ; -- call KILL^XOBVLL to finish NEW'ing and execute Kernel call to kill
+"RTN","XOBSRA1",57,0)
+ DO KILL^XOBVLL
+"RTN","XOBSRA1",58,0)
+ QUIT
+"RTN","XOBSRA1",59,0)
+ ;
+"VER")
+8.0^22.0
+**END**
+**END**