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:INBEG,$$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("") "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("") "RTN","EDPRPT5",62,0) D5 ; return counts and averages as XML "RTN","EDPRPT5",63,0) D XML^EDPX("") "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("") "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(SHIFT)) S Y=SHIFT "RTN","EDPRPT5",142,0) ;; "RTN","EDPRPT5",143,0) I TMSHIFT(SHIFT))!(TM=SHIFT(SHIFT))) S Y=SHIFT "RTN","EDPRPT5",144,0) E F I=2:1:SHIFT I TM") 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("") "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("") "RTN","EDPRPTBV",78,0) S X=$$XMLA^EDPX("average",.AVG) D XML^EDPX(X) "RTN","EDPRPTBV",79,0) D XML^EDPX("") "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**