- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWCV.m
r613 r623 1 ORWCV ; SLC/KCM - Background Cover Sheet Load; ; 3/6/08 6:34am 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,132,209,214,195,215,260,243**;Dec 17, 1997;Build 242 3 ; 4 ; DBIA 4011 Access ^XWB(8994) 5 ; DBIA 4313 Direct R/W permission to capacity mgmt global ^KMPTMP("KMPDT") 6 ; DBIA 10061 Reference to ^UTILITY 7 ; 8 START(VAL,DFN,IP,HWND,LOC,NODO,NEWREM) ; start cover sheet build in background 9 N ZTIO,ZTRTN,ZTDTH,ZTSAVE,ZTDESC,SECT,BACK,X,I,ORLIST,STR,FILE,NODE,ORHTIME,ORX 10 ; Capacity planning timing code uses ORHTIME 11 S ORHTIME=$H 12 S LOC=$G(LOC),NODO=";"_$G(NODO),NEWREM=+$G(NEWREM) 13 D GETLST^XPAR(.ORX,"SYS^PKG","ORWOR COVER RETRIEVAL NEW","Q") 14 S I=0 F S I=$O(ORX(I)) Q:'I I $D(^ORD(101.24,+ORX(I),0)) S SECT(+$P(^(0),"^",2))=$P(ORX(I),"^",2) 15 D GETLST^XPAR(.ORLIST,"ALL","ORWCV1 COVERSHEET LIST") 16 S (VAL,BACK,STR,FILE)="" 17 F S I=$O(ORLIST(I)) Q:'I I $D(^ORD(101.24,$P(ORLIST(I),"^",2),0)) S X0=^(0) D 18 . Q:$P(X0,"^",8)'="C" 19 . S X=$P(X0,"^",2) 20 . I NODO[(";"_X_";") Q ; if in NODO, dont do section 21 . S STR=STR_X_";" 22 . I '$G(SECT(X)) S VAL=VAL_X_";" ; load section in foreground 23 . E S BACK=BACK_X_";",FILE=FILE_$P(ORLIST(I),"^",2)_";" ; load section in background 24 Q:BACK="" 25 S ZTIO="ORW THREAD RESOURCE",ZTRTN="BUILD^ORWCV",ZTDTH=$H 26 S (ZTSAVE("DFN"),ZTSAVE("IP"),ZTSAVE("HWND"),ZTSAVE("NEWREM"),ZTSAVE("LOC"),ZTSAVE("BACK"),ZTSAVE("FILE"))="" 27 S ZTDESC="CPRS GUI Background Data Retrieval" 28 D ^%ZTLOAD I '$D(ZTSK) S VAL=STR Q 29 S NODE="ORWCV "_IP_"-"_HWND_"-"_DFN 30 K ^XTMP(NODE) 31 S ^XTMP(NODE,0)=$$FMADD^XLFDT(DT,1)_U_DT_U_"Background CPRS "_ZTSK 32 ; Start capacity planning timing clock - will be stopped in POLL code 33 I +$G(^KMPTMP("KMPD-CPRS")) S ^KMPTMP("KMPDT","ORWCV",NODE)=$G(ORHTIME)_"^^"_$G(DUZ)_"^"_$G(IO("CLNM")) 34 Q 35 BUILD ; called in background by task manager, expects DFN, JobID 36 N NODE,IFLE,ORFNUM,ID,ENT,RTN,INODE,PARAM1,PARAM2,DETAIL,X0,X2 37 S NODE="ORWCV "_IP_"-"_HWND_"-"_DFN 38 I $D(ZTQUEUED) S ZTREQ="@" 39 I $G(^XTMP(NODE,"STOP")) K ^XTMP(NODE) Q ; client no longer polling 40 I '$D(^XTMP(NODE,0)) Q ; XTMP node has been purged 41 L +^XTMP(NODE) 42 S ^XTMP(NODE,"DFN")=DFN 43 ;N $ETRAP,$ESTACK 44 ;S $ETRAP="D ERR^ORWCV Q" 45 I $L($G(FILE),";")>0 F IFLE=1:1:$L(FILE,";") S ORFNUM=$P(FILE,";",IFLE) Q:'$D(^ORD(101.24,+ORFNUM,0)) S X0=^(0),X2=$G(^(2)) D 46 . S ID=$P(X0,"^",2),ENT=$P(X0,"^",6),RTN=$P(X0,"^",5),PARAM1=$P(X2,"^"),PARAM2=$P(X2,"^",2),INODE=$P(X2,"^",5),DETAIL="" 47 . I $P(X0,"^",18) S DETAIL=$P($G(^ORD(101.24,+$P(X0,"^",18),0)),"^",13),DETAIL=$P($G(^XWB(8994,+DETAIL,0)),"^") ;DBIA 4011 48 . I '$L(INODE) Q 49 . I '$L(ENT) S LST(IFLE)="0^ERROR: Missing ENTRY POINT field in file 101.24 for "_$P(X0,"^")_", IFN="_+ORFNUM D LST2XTMP(INODE) Q 50 . I '$L(RTN) S LST(IFLE)="0^ERROR: Missing ROUTINE field in file 101.24 for "_$P(X0,"^")_", IFN="_+ORFNUM D LST2XTMP(INODE) Q 51 . I '$L($T(@(ENT_"^"_RTN))) S LST(IFLE)="0^ERROR: "_ENT_"~"_RTN_" does not exist. See file 101.24 entry: "_$P(X0,"^")_", IFN="_+ORFNUM D LST2XTMP(INODE) Q 52 . I ID=50 D:$L($T(STRT3^AWCMCPR1)) STRT3^AWCMCPR1 D D:$L($T(END^AWCMCPR1)) END^AWCMCPR1 Q ;Special case for reminders 53 .. I $G(NEWREM) D APPL^ORQQPXRM(.LST,DFN,LOC) I 1 54 .. E D @(ENT_"^"_RTN_"(.LST,DFN)") 55 .. D LST2XTMP(INODE) 56 . I $L(PARAM1),$L(PARAM2) D @(ENT_"^"_RTN_"(.LST,DFN,PARAM1,PARAM2)"),LST2XTMP(INODE) Q 57 . I $L(PARAM1) D @(ENT_"^"_RTN_"(.LST,DFN,PARAM1)"),LST2XTMP(INODE) Q 58 . D @(ENT_"^"_RTN_"(.LST,DFN)"),LST2XTMP(INODE) 59 S ^XTMP(NODE,"DONE")=1 60 I $G(^XTMP(NODE,"STOP")) K ^XTMP(NODE) 61 L -^XTMP(NODE) 62 Q 63 ERR ;Error trap 64 S $ETRAP="D UNWIND^ORWCV Q" 65 I $D(NODE) D 66 . I $D(INODE) S LST(0)="",LST(1)="0^ERROR DURING COVER SHEET BUILD:"_$ZERROR D LST2XTMP(INODE) 67 . S ^XTMP(NODE,"DONE")=1 68 . L -^XTMP(NODE) 69 D @^%ZOSF("ERRTN") ;file error 70 S $ECODE=",UOR70 error during Cover Sheet build," 71 Q 72 UNWIND ;Unwind Error stack 73 Q:$ESTACK>1 ;pop the stack 74 ;add additional code here, if needed 75 Q 76 LST2XTMP(ID) ; put the list in ^XTMP(NODE,ID) 77 I $G(^XTMP(NODE,"STOP")) Q 78 N I 79 I $L($G(DETAIL)) S I=0 F S I=$O(LST(I)) Q:'I S $P(LST(I),"^",12)=DETAIL 80 K ^XTMP(NODE,ID) M ^XTMP(NODE,ID)=LST S ^XTMP(NODE,ID)=1 K LST 81 Q 82 POLL(LST,DFN,IP,HWND) ; poll for completed cover sheet parts 83 N I,ILST,ID,NODE,DONE 84 S NODE="ORWCV "_IP_"-"_HWND_"-"_DFN,ILST=0,DONE=0 85 I '$D(^XTMP(NODE,"DFN")) Q 86 I ^XTMP(NODE,"DFN")'=DFN S LST(1)="~DONE=1" Q 87 I $G(^XTMP(NODE,"DONE")) S ILST=ILST+1,LST(ILST)="~DONE=1",DONE=1 88 F ID="PROB","CWAD","MEDS","RMND","LABS","VITL","VSIT" D 89 . I '$G(^XTMP(NODE,ID)) Q 90 . S ILST=ILST+1,LST(ILST)="~"_ID 91 . S I=0 F S I=$O(^XTMP(NODE,ID,I)) Q:'I S ILST=ILST+1,LST(ILST)="i"_^(I) 92 . K ^XTMP(NODE,ID) 93 ; Stop capacity planning timing clock - was started in START code 94 I DONE K ^XTMP(NODE) I +$G(^KMPTMP("KMPD-CPRS")) S $P(^KMPTMP("KMPDT","ORWCV",NODE),"^",2)=$H 95 Q 96 STOP(OK,DFN,IP,HWND) ; stop cover sheet data retrieval 97 S NODE="ORWCV "_IP_"-"_HWND_"-"_DFN,ILST=0,DONE=0 98 S ^XTMP(NODE,"STOP")=1,OK=1 99 L +^XTMP(NODE) 100 I $G(^XTMP(NODE,"DONE")) K ^XTMP(NODE) 101 L -^XTMP(NODE) 102 Q 103 CLEAN ; clean up ^XTMP nodes 104 S X="ORWCV" 105 F S X=$O(^XTMP(X)) Q:$E(X,1,5)'="ORWCV" W !,X K ^XTMP(X) 106 Q 107 LAB(LST,DFN) ; return labs for patient 108 D:$L($T(STRT2^AWCMCPR1)) STRT2^AWCMCPR1 109 D LIST^ORQOR1(.LST,DFN,"LAB",4,"T-"_$$RNGLAB(DFN),"T","AW",1) 110 D:$L($T(END^AWCMCPR1)) END^AWCMCPR1 111 Q 112 ; 113 VST1(ORVISIT,DFN,BEG,END,SKIP) ; 114 N ERR,ERRMSG 115 S ERR=0 ; kludge to return errors 116 Q:'$G(DFN) 117 D VST(.ORVISIT,DFN,.BEG,.END,$G(SKIP),.ERR,.ERRMSG) 118 I ERR K ORVISIT S ORVISIT(1)=ERRMSG 119 Q 120 ; 121 TEST ;D VST(.ZZZ,76,2950101,3050401,777,1,1) 122 Q 123 VST(ORVISIT,DFN,BEG,END,SKIP,ERR,ERRMSG) ; return appts/admissions for patient 124 N CHECKERR,VAERR,VASD,BDT,COUNT,DTM,EDT,LOC,NOW,ORQUERY,ORLST,STI,STS,TODAY,I,J,K,XI,XE,X 125 S CHECKERR=($G(ERR)=0) ; kludge to check for errors 126 S NOW=$$NOW^XLFDT(),TODAY=$P(NOW,".",1) 127 I '$G(BEG) S BEG=$$X2FM($$RNGVBEG) 128 I '$G(END) S END=$$X2FM($$RNGVEND)+0.2359 129 S COUNT=0 130 K ^TMP("ORVSTLIST",$J) 131 S VAERR=0 132 I END>NOW D Q:VAERR ; get future encounters, past cancels/no-shows from VADPT 133 . S VASD("F")=BEG 134 . S VASD("T")=END 135 . S VASD("W")="123456789" 136 . D SDA^ORQRY01(.ERR,.ERRMSG) 137 . I CHECKERR,ERR K ^UTILITY("VASD",$J) S ORVISIT(1)=ERRMSG Q ;IA 10061 138 . S I=0 F S I=$O(^UTILITY("VASD",$J,I)) Q:'I D 139 . . S XI=^UTILITY("VASD",$J,I,"I"),XE=^("E") 140 . . S DTM=$P(XI,U),IEN=$P(XI,U,2),STI=$P(XI,U,3) 141 . . S LOC=$P(XE,U,2),STS=$P(XE,U,3) 142 . . I DTM<TODAY,(STI=""!(STI["I")!(STI="NT")) Q ; no prior kept appts 143 . . S ^TMP("ORVSTLIST",$J,DTM,"A",1)="A;"_DTM_";"_IEN_U_DTM_U_LOC_U_STS 144 . K ^UTILITY("VASD",$J) 145 I BEG'>NOW D ;past encounters from ACRP Toolkit - set in CALLBACK 146 . S BDT=BEG 147 . S EDT=$S(END<NOW:END,1:NOW) 148 . D OPEN^SDQ(.ORQUERY) 149 . I '$$ERRCHK^SDQUT() D INDEX^SDQ(.ORQUERY,"PATIENT/DATE","SET") 150 . I '$$ERRCHK^SDQUT() D PAT^SDQ(.ORQUERY,DFN,"SET") 151 . I '$$ERRCHK^SDQUT() D DATE^SDQ(.ORQUERY,BDT,EDT,"SET") 152 . I '$$ERRCHK^SDQUT() D 153 . . S ORLST=$NA(^TMP("ORVSTLIST",$J)) 154 . . D SCANCB^SDQ(.ORQUERY,"D CALLBACK^ORWCV(Y,Y0,.ORLST,.ORSTOP)","SET") 155 . I '$$ERRCHK^SDQUT() D ACTIVE^SDQ(.ORQUERY,"TRUE","SET") 156 . I '$$ERRCHK^SDQUT() D SCAN^SDQ(.ORQUERY,"FORWARD") 157 . D CLOSE^SDQ(.ORQUERY) 158 ; 159 I '$G(SKIP) D 160 . N TIM,MOV,X0,Y,MTIM,XTYP,XLOC,HLOC,EARLY,DONE ; admits 161 . S EARLY=$$X2FM($$RNGVBEG),DONE=0 162 . S TIM="" F S TIM=$O(^DGPM("ATID1",DFN,TIM)) Q:TIM'>0 D Q:DONE 163 . . S MOV=0 F S MOV=$O(^DGPM("ATID1",DFN,TIM,MOV)) Q:MOV'>0 D Q:DONE 164 . . . S X0=^DGPM(MOV,0),MTIM=$P(X0,U) 165 . . . I MTIM<EARLY S DONE=1 Q 166 . . . S XTYP=$P($G(^DG(405.1,+$P(X0,U,4),0)),U,1) 167 . . . S XLOC=$P($G(^DIC(42,+$P(X0,U,6),0)),U,1),HLOC=+$G(^(44)) 168 . . . S ^TMP("ORVSTLIST",$J,MTIM,"I",1)="I;"_MTIM_";"_HLOC_U_MTIM_U_"Inpatient Stay"_U_XLOC_U_XTYP 169 ; 170 S COUNT=0 171 S I=0 F S I=$O(^TMP("ORVSTLIST",$J,I)) Q:'I D 172 . S J="" F S J=$O(^TMP("ORVSTLIST",$J,I,J)) Q:J="" D 173 . . S K=0 F S K=$O(^TMP("ORVSTLIST",$J,I,J,K)) Q:'K D 174 . . . S COUNT=COUNT+1 175 . . . S ORVISIT(COUNT)=^TMP("ORVSTLIST",$J,I,J,K) 176 K ^TMP("ORVSTLIST",$J) 177 Q 178 CALLBACK(IEN,NODE0,ARRAY,STOP) ; called back from ACRP Toolkit for encounters 179 ; 180 ; IEN and NODE0 relate to Outpatient Encounter File 181 ; set STOP to 1 if need to quit 182 ; 183 N COUNT,DTM,LOC,OOS,TYPE,XSTAT,XLOC 184 S DTM=+NODE0,COUNT=1 185 S LOC=$P(NODE0,"^",4) 186 S XLOC=$P($G(^SC(+LOC,0)),U),OOS=$G(^("OOS")) 187 I OOS Q ; ignore OOS locations 188 I $P(NODE0,"^",6) Q ; not parent encounter 189 S XSTAT=$P($G(^SD(409.63,+$P(NODE0,"^",12),0)),"^") 190 S TYPE=$S($P(NODE0,"^",8)=1:"A",1:"V") 191 I TYPE="V",$D(@ARRAY@(DTM,"V")) S COUNT=$O(@ARRAY@(DTM,"V","A"),-1)+1 ; same d/t 192 S @ARRAY@(DTM,TYPE,COUNT)=TYPE_";"_DTM_";"_LOC_U_DTM_U_XLOC_U_XSTAT 193 Q 194 DTLVST(RPT,DFN,IEN,APPTINFO) ; return progress notes / discharge summary 195 N VISIT 196 I $P(APPTINFO,";")="A" D Q 197 . S VISIT=$$APPT2VST^PXAPI(DFN,$P(APPTINFO,";",2),$P(APPTINFO,";",3)) 198 . I VISIT=0 S VISIT=+$$GETENC^PXAPI(DFN,$P(APPTINFO,";",2),$P(APPTINFO,";",3)) 199 . D DETNOTE^ORQQVS(.RPT,DFN,VISIT) 200 I $P(APPTINFO,";")="V" D Q 201 . S VISIT=+$$GETENC^PXAPI(DFN,$P(APPTINFO,";",2),$P(APPTINFO,";",3)) 202 . D DETNOTE^ORQQVS(.RPT,DFN,VISIT) 203 I $P(APPTINFO,";")="I" D Q 204 . S VISIT=+$$GETENC^PXAPI(DFN,$P(APPTINFO,";",2),$P(APPTINFO,";",3)) 205 . D DETSUM^ORQQVS(.RPT,DFN,VISIT) 206 . K ^TMP("PXKENC",$J) 207 Q 208 X2FM(X) ; return FM date given relative date 209 N %DT S %DT="TS" D ^%DT 210 Q Y 211 RNGLAB(DFN) ; return days back for patient 212 N INPT,PAR 213 S INPT=0 I $L($G(^DPT(DFN,.1))) S INPT=1 214 S PAR="ORQQLR DATE RANGE "_$S(INPT:"INPT",1:"OUTPT") 215 Q $$GET^XPAR("ALL",PAR,1,"I") 216 ; 217 RNGVBEG() ; return start date for encounters 218 Q $$GET^XPAR("ALL","ORQQCSDR CS RANGE START",1,"I") 219 ; 220 RNGVEND() ; return stop date for encounters 221 Q $$GET^XPAR("ALL","ORQQCSDR CS RANGE STOP",1,"I") 222 ; 223 RANGES(REC,DFN) ; return ranges given a patient 224 N REC 225 S REC=$$RNGLAB(DFN)_U_$$RNGVBEG_U_$$RNGVEND 226 Q 1 ORWCV ; SLC/KCM - Background Cover Sheet Load; ;11/2/06 15:07 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,132,209,214,195,215,260**;Dec 17, 1997;Build 26 3 ; 4 ; DBIA 4011 Access ^XWB(8994) 5 ; DBIA 4313 Direct R/W permission to capacity mgmt global ^KMPTMP("KMPDT") 6 ; DBIA 10061 Reference to ^UTILITY 7 ; 8 START(VAL,DFN,IP,HWND,LOC,NODO,NEWREM) ; start cover sheet build in background 9 N ZTIO,ZTRTN,ZTDTH,ZTSAVE,ZTDESC,SECT,BACK,X,I,ORLIST,STR,FILE,NODE,ORHTIME,ORX 10 ; Capacity planning timing code uses ORHTIME 11 S ORHTIME=$H 12 S LOC=$G(LOC),NODO=";"_$G(NODO),NEWREM=+$G(NEWREM) 13 D GETLST^XPAR(.ORX,"SYS^PKG","ORWOR COVER RETRIEVAL NEW","Q") 14 S I=0 F S I=$O(ORX(I)) Q:'I I $D(^ORD(101.24,+ORX(I),0)) S SECT(+$P(^(0),"^",2))=$P(ORX(I),"^",2) 15 D GETLST^XPAR(.ORLIST,"ALL","ORWCV1 COVERSHEET LIST") 16 S (VAL,BACK,STR,FILE)="" 17 F S I=$O(ORLIST(I)) Q:'I I $D(^ORD(101.24,$P(ORLIST(I),"^",2),0)) S X0=^(0) D 18 . Q:$P(X0,"^",8)'="C" 19 . S X=$P(X0,"^",2) 20 . I NODO[(";"_X_";") Q ; if in NODO, dont do section 21 . S STR=STR_X_";" 22 . I '$G(SECT(X)) S VAL=VAL_X_";" ; load section in foreground 23 . E S BACK=BACK_X_";",FILE=FILE_$P(ORLIST(I),"^",2)_";" ; load section in background 24 Q:BACK="" 25 S ZTIO="ORW THREAD RESOURCE",ZTRTN="BUILD^ORWCV",ZTDTH=$H 26 S (ZTSAVE("DFN"),ZTSAVE("IP"),ZTSAVE("HWND"),ZTSAVE("NEWREM"),ZTSAVE("LOC"),ZTSAVE("BACK"),ZTSAVE("FILE"))="" 27 S ZTDESC="CPRS GUI Background Data Retrieval" 28 D ^%ZTLOAD I '$D(ZTSK) S VAL=STR Q 29 S NODE="ORWCV "_IP_"-"_HWND_"-"_DFN 30 K ^XTMP(NODE) 31 S ^XTMP(NODE,0)=$$FMADD^XLFDT(DT,1)_U_DT_U_"Background CPRS "_ZTSK 32 ; Start capacity planning timing clock - will be stopped in POLL code 33 I +$G(^KMPTMP("KMPD-CPRS")) S ^KMPTMP("KMPDT","ORWCV",NODE)=$G(ORHTIME)_"^^"_$G(DUZ)_"^"_$G(IO("CLNM")) 34 Q 35 BUILD ; called in background by task manager, expects DFN, JobID 36 N NODE,IFLE,ORFNUM,ID,ENT,RTN,INODE,PARAM1,PARAM2,DETAIL,X0,X2 37 S NODE="ORWCV "_IP_"-"_HWND_"-"_DFN 38 I $D(ZTQUEUED) S ZTREQ="@" 39 I $G(^XTMP(NODE,"STOP")) K ^XTMP(NODE) Q ; client no longer polling 40 I '$D(^XTMP(NODE,0)) Q ; XTMP node has been purged 41 L +^XTMP(NODE) 42 S ^XTMP(NODE,"DFN")=DFN 43 ;N $ETRAP,$ESTACK 44 ;S $ETRAP="D ERR^ORWCV Q" 45 I $L($G(FILE),";")>0 F IFLE=1:1:$L(FILE,";") S ORFNUM=$P(FILE,";",IFLE) Q:'$D(^ORD(101.24,+ORFNUM,0)) S X0=^(0),X2=$G(^(2)) D 46 . S ID=$P(X0,"^",2),ENT=$P(X0,"^",6),RTN=$P(X0,"^",5),PARAM1=$P(X2,"^"),PARAM2=$P(X2,"^",2),INODE=$P(X2,"^",5),DETAIL="" 47 . I $P(X0,"^",18) S DETAIL=$P($G(^ORD(101.24,+$P(X0,"^",18),0)),"^",13),DETAIL=$P($G(^XWB(8994,+DETAIL,0)),"^") ;DBIA 4011 48 . I '$L(INODE) Q 49 . I '$L(ENT) S LST(IFLE)="0^ERROR: Missing ENTRY POINT field in file 101.24 for "_$P(X0,"^")_", IFN="_+ORFNUM D LST2XTMP(INODE) Q 50 . I '$L(RTN) S LST(IFLE)="0^ERROR: Missing ROUTINE field in file 101.24 for "_$P(X0,"^")_", IFN="_+ORFNUM D LST2XTMP(INODE) Q 51 . I '$L($T(@(ENT_"^"_RTN))) S LST(IFLE)="0^ERROR: "_ENT_"~"_RTN_" does not exist. See file 101.24 entry: "_$P(X0,"^")_", IFN="_+ORFNUM D LST2XTMP(INODE) Q 52 . I ID=50 D:$L($T(STRT3^AWCMCPR1)) STRT3^AWCMCPR1 D D:$L($T(END^AWCMCPR1)) END^AWCMCPR1 Q ;Special case for reminders 53 .. I $G(NEWREM) D APPL^ORQQPXRM(.LST,DFN,LOC) I 1 54 .. E D @(ENT_"^"_RTN_"(.LST,DFN)") 55 .. D LST2XTMP(INODE) 56 . I $L(PARAM1),$L(PARAM2) D @(ENT_"^"_RTN_"(.LST,DFN,PARAM1,PARAM2)"),LST2XTMP(INODE) Q 57 . I $L(PARAM1) D @(ENT_"^"_RTN_"(.LST,DFN,PARAM1)"),LST2XTMP(INODE) Q 58 . D @(ENT_"^"_RTN_"(.LST,DFN)"),LST2XTMP(INODE) 59 S ^XTMP(NODE,"DONE")=1 60 I $G(^XTMP(NODE,"STOP")) K ^XTMP(NODE) 61 L -^XTMP(NODE) 62 Q 63 ERR ;Error trap 64 S $ETRAP="D UNWIND^ORWCV Q" 65 I $D(NODE) D 66 . I $D(INODE) S LST(0)="",LST(1)="0^ERROR DURING COVER SHEET BUILD:"_$ZERROR D LST2XTMP(INODE) 67 . S ^XTMP(NODE,"DONE")=1 68 . L -^XTMP(NODE) 69 D @^%ZOSF("ERRTN") ;file error 70 S $ECODE=",UOR70 error during Cover Sheet build," 71 Q 72 UNWIND ;Unwind Error stack 73 Q:$ESTACK>1 ;pop the stack 74 ;add additional code here, if needed 75 Q 76 LST2XTMP(ID) ; put the list in ^XTMP(NODE,ID) 77 I $G(^XTMP(NODE,"STOP")) Q 78 N I 79 I $L($G(DETAIL)) S I=0 F S I=$O(LST(I)) Q:'I S $P(LST(I),"^",12)=DETAIL 80 K ^XTMP(NODE,ID) M ^XTMP(NODE,ID)=LST S ^XTMP(NODE,ID)=1 K LST 81 Q 82 POLL(LST,DFN,IP,HWND) ; poll for completed cover sheet parts 83 N I,ILST,ID,NODE,DONE 84 S NODE="ORWCV "_IP_"-"_HWND_"-"_DFN,ILST=0,DONE=0 85 I '$D(^XTMP(NODE,"DFN")) Q 86 I ^XTMP(NODE,"DFN")'=DFN S LST(1)="~DONE=1" Q 87 I $G(^XTMP(NODE,"DONE")) S ILST=ILST+1,LST(ILST)="~DONE=1",DONE=1 88 F ID="PROB","CWAD","MEDS","RMND","LABS","VITL","VSIT" D 89 . I '$G(^XTMP(NODE,ID)) Q 90 . S ILST=ILST+1,LST(ILST)="~"_ID 91 . S I=0 F S I=$O(^XTMP(NODE,ID,I)) Q:'I S ILST=ILST+1,LST(ILST)="i"_^(I) 92 . K ^XTMP(NODE,ID) 93 ; Stop capacity planning timing clock - was started in START code 94 I DONE K ^XTMP(NODE) I +$G(^KMPTMP("KMPD-CPRS")) S $P(^KMPTMP("KMPDT","ORWCV",NODE),"^",2)=$H 95 Q 96 STOP(OK,DFN,IP,HWND) ; stop cover sheet data retrieval 97 S NODE="ORWCV "_IP_"-"_HWND_"-"_DFN,ILST=0,DONE=0 98 S ^XTMP(NODE,"STOP")=1,OK=1 99 L +^XTMP(NODE) 100 I $G(^XTMP(NODE,"DONE")) K ^XTMP(NODE) 101 L -^XTMP(NODE) 102 Q 103 CLEAN ; clean up ^XTMP nodes 104 S X="ORWCV" 105 F S X=$O(^XTMP(X)) Q:$E(X,1,5)'="ORWCV" W !,X K ^XTMP(X) 106 Q 107 LAB(LST,DFN) ; return labs for patient 108 D:$L($T(STRT2^AWCMCPR1)) STRT2^AWCMCPR1 109 D LIST^ORQOR1(.LST,DFN,"LAB",4,"T-"_$$RNGLAB(DFN),"T","AW",1) 110 D:$L($T(END^AWCMCPR1)) END^AWCMCPR1 111 Q 112 ; 113 VST1(ORVISIT,DFN,BEG,END,SKIP) ; 114 N ERR,ERRMSG 115 S ERR=0 ; kludge to return errors 116 D VST(.ORVISIT,DFN,.BEG,.END,$G(SKIP),.ERR,.ERRMSG) 117 I ERR K ORVISIT S ORVISIT(1)=ERRMSG 118 Q 119 ; 120 TEST ;D VST(.ZZZ,76,2950101,3050401,777,1,1) 121 Q 122 VST(ORVISIT,DFN,BEG,END,SKIP,ERR,ERRMSG) ; return appts/admissions for patient 123 N CHECKERR,VAERR,VASD,BDT,COUNT,DTM,EDT,LOC,NOW,ORQUERY,ORLST,STI,STS,TODAY,I,J,K,XI,XE,X 124 S CHECKERR=($G(ERR)=0) ; kludge to check for errors 125 S NOW=$$NOW^XLFDT(),TODAY=$P(NOW,".",1) 126 I '$G(BEG) S BEG=$$X2FM($$RNGVBEG) 127 I '$G(END) S END=$$X2FM($$RNGVEND)+0.2359 128 S COUNT=0 129 K ^TMP("ORVSTLIST",$J) 130 S VAERR=0 131 I END>NOW D Q:VAERR ; get future encounters, past cancels/no-shows from VADPT 132 . S VASD("F")=BEG 133 . S VASD("T")=END 134 . S VASD("W")="123456789" 135 . D SDA^ORQRY01(.ERR,.ERRMSG) 136 . I CHECKERR,ERR K ^UTILITY("VASD",$J) S ORVISIT(1)=ERRMSG Q ;IA 10061 137 . S I=0 F S I=$O(^UTILITY("VASD",$J,I)) Q:'I D 138 . . S XI=^UTILITY("VASD",$J,I,"I"),XE=^("E") 139 . . S DTM=$P(XI,U),IEN=$P(XI,U,2),STI=$P(XI,U,3) 140 . . S LOC=$P(XE,U,2),STS=$P(XE,U,3) 141 . . I DTM<TODAY,(STI=""!(STI["I")!(STI="NT")) Q ; no prior kept appts 142 . . S ^TMP("ORVSTLIST",$J,DTM,"A",1)="A;"_DTM_";"_IEN_U_DTM_U_LOC_U_STS 143 . K ^UTILITY("VASD",$J) 144 I BEG'>NOW D ;past encounters from ACRP Toolkit - set in CALLBACK 145 . S BDT=BEG 146 . S EDT=$S(END<NOW:END,1:NOW) 147 . D OPEN^SDQ(.ORQUERY) 148 . I '$$ERRCHK^SDQUT() D INDEX^SDQ(.ORQUERY,"PATIENT/DATE","SET") 149 . I '$$ERRCHK^SDQUT() D PAT^SDQ(.ORQUERY,DFN,"SET") 150 . I '$$ERRCHK^SDQUT() D DATE^SDQ(.ORQUERY,BDT,EDT,"SET") 151 . I '$$ERRCHK^SDQUT() D 152 . . S ORLST=$NA(^TMP("ORVSTLIST",$J)) 153 . . D SCANCB^SDQ(.ORQUERY,"D CALLBACK^ORWCV(Y,Y0,.ORLST,.ORSTOP)","SET") 154 . I '$$ERRCHK^SDQUT() D ACTIVE^SDQ(.ORQUERY,"TRUE","SET") 155 . I '$$ERRCHK^SDQUT() D SCAN^SDQ(.ORQUERY,"FORWARD") 156 . D CLOSE^SDQ(.ORQUERY) 157 ; 158 I '$G(SKIP) D 159 . N TIM,MOV,X0,Y,MTIM,XTYP,XLOC,HLOC,EARLY,DONE ; admits 160 . S EARLY=$$X2FM($$RNGVBEG),DONE=0 161 . S TIM="" F S TIM=$O(^DGPM("ATID1",DFN,TIM)) Q:TIM'>0 D Q:DONE 162 . . S MOV=0 F S MOV=$O(^DGPM("ATID1",DFN,TIM,MOV)) Q:MOV'>0 D Q:DONE 163 . . . S X0=^DGPM(MOV,0),MTIM=$P(X0,U) 164 . . . I MTIM<EARLY S DONE=1 Q 165 . . . S XTYP=$P($G(^DG(405.1,+$P(X0,U,4),0)),U,1) 166 . . . S XLOC=$P($G(^DIC(42,+$P(X0,U,6),0)),U,1),HLOC=+$G(^(44)) 167 . . . S ^TMP("ORVSTLIST",$J,MTIM,"I",1)="I;"_MTIM_";"_HLOC_U_MTIM_U_"Inpatient Stay"_U_XLOC_U_XTYP 168 ; 169 S COUNT=0 170 S I=0 F S I=$O(^TMP("ORVSTLIST",$J,I)) Q:'I D 171 . S J="" F S J=$O(^TMP("ORVSTLIST",$J,I,J)) Q:J="" D 172 . . S K=0 F S K=$O(^TMP("ORVSTLIST",$J,I,J,K)) Q:'K D 173 . . . S COUNT=COUNT+1 174 . . . S ORVISIT(COUNT)=^TMP("ORVSTLIST",$J,I,J,K) 175 K ^TMP("ORVSTLIST",$J) 176 Q 177 CALLBACK(IEN,NODE0,ARRAY,STOP) ; called back from ACRP Toolkit for encounters 178 ; 179 ; IEN and NODE0 relate to Outpatient Encounter File 180 ; set STOP to 1 if need to quit 181 ; 182 N COUNT,DTM,LOC,OOS,TYPE,XSTAT,XLOC 183 S DTM=+NODE0,COUNT=1 184 S LOC=$P(NODE0,"^",4) 185 S XLOC=$P($G(^SC(+LOC,0)),U),OOS=$G(^("OOS")) 186 I OOS Q ; ignore OOS locations 187 I $P(NODE0,"^",6) Q ; not parent encounter 188 S XSTAT=$P($G(^SD(409.63,+$P(NODE0,"^",12),0)),"^") 189 S TYPE=$S($P(NODE0,"^",8)=1:"A",1:"V") 190 I TYPE="V",$D(@ARRAY@(DTM,"V")) S COUNT=$O(@ARRAY@(DTM,"V","A"),-1)+1 ; same d/t 191 S @ARRAY@(DTM,TYPE,COUNT)=TYPE_";"_DTM_";"_LOC_U_DTM_U_XLOC_U_XSTAT 192 Q 193 DTLVST(RPT,DFN,IEN,APPTINFO) ; return progress notes / discharge summary 194 N VISIT 195 I $P(APPTINFO,";")="A" D Q 196 . S VISIT=$$APPT2VST^PXAPI(DFN,$P(APPTINFO,";",2),$P(APPTINFO,";",3)) 197 . I VISIT=0 S VISIT=+$$GETENC^PXAPI(DFN,$P(APPTINFO,";",2),$P(APPTINFO,";",3)) 198 . D DETNOTE^ORQQVS(.RPT,DFN,VISIT) 199 I $P(APPTINFO,";")="V" D Q 200 . S VISIT=+$$GETENC^PXAPI(DFN,$P(APPTINFO,";",2),$P(APPTINFO,";",3)) 201 . D DETNOTE^ORQQVS(.RPT,DFN,VISIT) 202 I $P(APPTINFO,";")="I" D Q 203 . S VISIT=+$$GETENC^PXAPI(DFN,$P(APPTINFO,";",2),$P(APPTINFO,";",3)) 204 . D DETSUM^ORQQVS(.RPT,DFN,VISIT) 205 . K ^TMP("PXKENC",$J) 206 Q 207 X2FM(X) ; return FM date given relative date 208 N %DT S %DT="TS" D ^%DT 209 Q Y 210 RNGLAB(DFN) ; return days back for patient 211 N INPT,PAR 212 S INPT=0 I $L($G(^DPT(DFN,.1))) S INPT=1 213 S PAR="ORQQLR DATE RANGE "_$S(INPT:"INPT",1:"OUTPT") 214 Q $$GET^XPAR("ALL",PAR,1,"I") 215 ; 216 RNGVBEG() ; return start date for encounters 217 Q $$GET^XPAR("ALL","ORQQCSDR CS RANGE START",1,"I") 218 ; 219 RNGVEND() ; return stop date for encounters 220 Q $$GET^XPAR("ALL","ORQQCSDR CS RANGE STOP",1,"I") 221 ; 222 RANGES(REC,DFN) ; return ranges given a patient 223 N REC 224 S REC=$$RNGLAB(DFN)_U_$$RNGVBEG_U_$$RNGVEND 225 Q
Note:
See TracChangeset
for help on using the changeset viewer.
