Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPW8.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPW8.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPW8.m
r613 r623 1 SCRPW8 ;RENO/KEITH - Outpatient Encounter Workload Statistics ; 04 Feb 99 4:53 PM 2 ;;5.3;Scheduling;**139,145,144,176,339,466,510**;AUG 13, 1993;Build 3 3 QS ;Queue outpatient encounter workload report 4 D PARM^SCRPW9 Q 5 ; 6 PST ;Print stats 7 N X,Y,% 8 D NOW^%DTC S Y=% X ^DD("DD") S SDPAGE=1,SDPNOW=$P(Y,":",1,2),SDDT=SDDTF,SDMC=$O(^DG(43,0)),SDMC=$G(^DG(43,+SDMC,"GL")),SDMD=$P(SDMC,U,2),(SDOUT,SDSTOP,SDFF)=0 9 S SDDNAM=$P($G(^DG(40.8,+$$PRIM^VASITE(),0)),U,7),SDDNAM=$$GET1^DIQ(4,+SDDNAM,.01) S:'$L(SDDNAM) SDDNAM=$P($G(^DG(40.8,+$P(SDMC,U,3),0)),U) 10 F I="SCRPW","SCRPWD","SCRPWC" K ^TMP(I,$J) 11 F S SDDT=$O(^SCE("B",SDDT)) Q:'SDDT!(SDDT>SDDTL)!SDOUT S SDOE=0 D 12 .F S SDOE=$O(^SCE("B",SDDT,SDOE)) Q:'SDOE!SDOUT S SDOE0=$$GETOE^SDOE(SDOE) I $L(SDOE0),'$P(SDOE0,U,6),$P(SDOE0,U,2),$P(SDOE0,U,11),$P(SDOE0,U,12) S SDDIV=$$DIV(),SDCG=$$CLGR() D COUNT 13 .Q 14 I '$D(^TMP("SCRPW",$J)) D XHDR S SDX="No activity found within the parameters specified." W !!?(80-$L(SDX)\2),SDX G EXIT 15 F SDS1="SCRPW","SCRPWD","SCRPWC" S SDS2="" F S SDS2=$O(^TMP(SDS1,$J,SDS2)) Q:SDS2=""!SDOUT D STCT 16 G:SDOUT EXIT D:$E(IOST)="C" DISP0^SCRPW23 17 F SDS1="SCRPW","SCRPWD","SCRPWC" S SDS2="" F S SDS2=$O(^TMP(SDS1,$J,SDS2)) Q:SDS2=""!SDOUT D PRPT 18 G:SDOUT EXIT 19 D:SDZ(0) DPRT^SCRPW9("SCRPW",SDDNAM) G:SDOUT EXIT D:SDUL UNARL^SCRPW9("SCRPW",SDDNAM) G EXIT 20 ; 21 STCT S (SDUNCO,SDCT,DFN)=0 D STOP Q:SDOUT 22 F S DFN=$O(^TMP(SDS1,$J,SDS2,"VISIT","ACC",DFN)) Q:'DFN S SDUNCO=SDUNCO+1,SDDT=0 F S SDDT=$O(^TMP(SDS1,$J,SDS2,"VISIT","ACC",DFN,SDDT)) Q:'SDDT S SDCT=SDCT+1 23 S ^TMP(SDS1,$J,SDS2,"UNIQUE","UNCO")=SDUNCO,^TMP(SDS1,$J,SDS2,"VISIT","OWK")=SDCT,(SDUNAR,SDCT,DFN)=0 24 S DFN=0 F S DFN=$O(^TMP(SDS1,$J,SDS2,"VISIT","OWK",DFN)) Q:'DFN D NCT1 25 S DFN=0 F S DFN=$O(^TMP(SDS1,$J,SDS2,"VISIT","NWK",DFN)) Q:'DFN D CT1 26 S ^TMP(SDS1,$J,SDS2,"UNIQUE","UNAR")=SDUNAR,^TMP(SDS1,$J,SDS2,"VISIT","NWK")=SDCT Q 27 ; 28 PRPT ;Print statistics page 29 D STOP Q:SDOUT 30 S SDCT=0 F SDI=1,2,3,11,14,"8-CC" S SDCT=SDCT+$G(^TMP(SDS1,$J,SDS2,SDI)) 31 D XHDR Q:SDOUT D SHDR("O U T P A T I E N T E N C O U N T E R W O R K L O A D") Q:SDOUT F SDI=11,14,3,1 D LIST(SDI) Q:SDOUT 32 I $D(^TMP(SDS1,$J,SDS2,2)) D:$Y>(IOSL-4) XHDR Q:SDOUT W !?10,"CHECKED OUT" S SDI=0 F S SDI=$O(^TMP(SDS1,$J,SDS2,2,SDI)) Q:'SDI!SDOUT S SDSTAT=$O(^TMP(SDS1,$J,SDS2,2,SDI,"")) D COT 33 I $D(^TMP(SDS1,$J,SDS2,"8-CC")) D:$Y>(IOSL-4) XHDR Q:SDOUT W !?10,"INPATIENT APPOINTMENT" S SDI=0 F S SDI=$O(^TMP(SDS1,$J,SDS2,"8-CC",SDI)) Q:'SDI!SDOUT S SDSTAT=$O(^TMP(SDS1,$J,SDS2,"8-CC",SDI,"")) D IAP 34 D TOT S (SDI,SDCT)=0 F SDI=4,5,6,7,"8-NC",9,12,13 S SDCT=SDCT+$G(^TMP(SDS1,$J,SDS2,SDI)) 35 W !! D SHDR("N O N - W O R K L O A D") Q:SDOUT F SDI="8-NC",12,4,6,5,7,9,10,13 D LIST(SDI) Q:SDOUT 36 D TOT W !! D SHDR(($$HD2()_" O U T P A T I E N T V I S I T S")) Q:SDOUT S SDCT=^TMP(SDS1,$J,SDS2,"VISIT","NWK")+^TMP(SDS1,$J,SDS2,"VISIT","OWK") 37 D:$Y>(IOSL-4) XHDR Q:SDOUT W !?10,"Act. Req./not accepted visits",?47,$J(^TMP(SDS1,$J,SDS2,"VISIT","NWK"),12),?62,$J($S(SDCT=0:0,1:(^TMP(SDS1,$J,SDS2,"VISIT","NWK")*100/SDCT)),8,2) 38 D:$Y>(IOSL-4) XHDR Q:SDOUT W !?10,"Transmitted, accepted visits",?47,$J(^TMP(SDS1,$J,SDS2,"VISIT","OWK"),12),?62,$J($S(SDCT=0:0,1:(^TMP(SDS1,$J,SDS2,"VISIT","OWK")*100/SDCT)),8,2) 39 D TOT 40 W !! D SHDR(($$HD2()_" O U T P A T I E N T U N I Q U E S")) Q:SDOUT 41 S SDUNCO=^TMP(SDS1,$J,SDS2,"UNIQUE","UNCO"),SDUNAR=^TMP(SDS1,$J,SDS2,"UNIQUE","UNAR"),SDCT=SDUNCO+SDUNAR 42 D:$Y>(IOSL-4) XHDR Q:SDOUT W !?10,"Act. Req./not accepted unique pts.",?47,$J(SDUNAR,12),?62,$J($S(SDCT=0:0,1:SDUNAR*100/SDCT),8,2) 43 D:$Y>(IOSL-4) XHDR Q:SDOUT W !?10,"Transmitted, accepted unique pts.",?47,$J(SDUNCO,12),?62,$J($S(SDCT=0:0,1:SDUNCO*100/SDCT),8,2) D TOT 44 Q 45 ; 46 XHDR I $E(IOST)="C",SDPAGE>1 N DIR S DIR(0)="E" D ^DIR S SDOUT=Y'=1 Q:SDOUT 47 S SDLINE="",$P(SDLINE,"-",81)="" W:SDPAGE>1!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0) W:$X $$XY^SCRPW50("",0,0) W SDLINE,!?15,"<*> OUTPATIENT ENCOUNTER WORKLOAD STATISTICS <*>" 48 I $D(^TMP("SCRPW",$J)) S X=$$HD1() W !?(80-$L(X)\2),X 49 W !,SDLINE,!,"For encounter dates ",SDDTPF," to ",SDDTPL,!,"Date printed: ",SDPNOW,?(74-$L(SDPAGE)),"Page: ",SDPAGE,!,SDLINE,! S SDPAGE=SDPAGE+1 50 Q 51 ; 52 EXIT K SDTOE0,SDUNCO,SDUNAR,SDCT,DFN,SDDT,SDDTF,SDDTL,SDDTPF,SDDTPL,SDI,SDLINE,SDOE,SDOE0,SDPNOW,SDSTAT,SDSTX,SDTOE,SDTOEE,SDTOE1,SDTX,SDTXS,SDX,SDZ,DTOUT,X,Y,ZTDESC,ZTRTN,ZTSAVE 53 D KVA^VADPT K X1,X2,SDH,SDHL,SDPNAM,SDSSN,SDPAGE,SDPT0,SDUL,DUOUT,SDARCT,SDST,SDPNOW,SDMD,SDMC,SDDIV,SDDNAM,SDS1,SDS2,SDCG,SDCLGR F I="SCRPW","SCRPWD","SCRPWC" K ^TMP(I,$J) 54 K I,SDFF,SDOUT,SDSTOP,SDNCOU D END^SCRPW50 Q 55 ; 56 HD1() ;Report subheader 1 57 Q $S(SDS1="SCRPW":"For station: ",SDS1="SCRPWD":"For division: ",1:"For clinic group: ")_SDS2 58 ; 59 HD2() ;Report subheader 2 60 Q $S(SDS1="SCRPW":"F A C I L I T Y",SDS1="SCRPWD":"D I V I S I O N",1:"C L I N I C G R O U P") 61 ; 62 DIV() ;Return division name 63 N X S X=$P($G(^DG(40.8,+$P(SDOE0,U,11),0)),U) Q $S('$L(X):"***UNKNOWN***",1:X) 64 ; 65 CLGR() ;Return CLINIC GROUP pointer 66 N X S X=$P($G(^SC(+$P(SDOE0,U,4),0)),U,31),X=$P($G(^SD(409.67,+X,0)),U) Q $S('$L(X):"***NONE ASSIGNED***",1:X) 67 ; 68 NCT1 I '$D(^TMP(SDS1,$J,SDS2,"VISIT","ACC",DFN)) S SDUNAR=SDUNAR+1 D:SDUL&(SDS1="SCRPW") UL("OWK") 69 S SDDT=0 F S SDDT=$O(^TMP(SDS1,$J,SDS2,"VISIT","OWK",DFN,SDDT)) Q:'SDDT I '$D(^TMP(SDS1,$J,SDS2,"VISIT","ACC",DFN,SDDT)) S SDCT=SDCT+1 70 Q 71 ; 72 CT1 I '$D(^TMP(SDS1,$J,SDS2,"VISIT","OWK",DFN)),'$D(^TMP(SDS1,$J,SDS2,"VISIT","ACC",DFN)) S SDUNAR=SDUNAR+1 D:SDUL&(SDS1="SCRPW") UL("NWK") 73 S SDDT=0 F S SDDT=$O(^TMP(SDS1,$J,SDS2,"VISIT","NWK",DFN,SDDT)) Q:'SDDT I '$D(^TMP(SDS1,$J,SDS2,"VISIT","OWK",DFN,SDDT)),'$D(^TMP(SDS1,$J,SDS2,"VISIT","ACC",DFN,SDDT)) S SDCT=SDCT+1 74 Q 75 ; 76 UL(SDI) D ^VADPT S SDDT=0 F S SDDT=$O(^TMP(SDS1,$J,SDS2,"VISIT",SDI,DFN,SDDT)) Q:'SDDT S ^TMP(SDS1,$J,SDS2,"VISIT","UNARL",VADM(1),DFN,$P(VADM(2),U),SDDT)="" 77 Q 78 ; 79 TOT W !?47,"============ =========",!?39,"TOTAL:",?47,$J(SDCT,12),?64,"100.00" Q 80 ; 81 SHDR(SDTX) D:$Y>(IOSL-6) XHDR Q:SDOUT W !!?(80-$L(SDTX)\2),SDTX,!?(80-$L(SDTX)\2) F SDX=1:1:$L(SDTX) W "-" 82 W !!?39,"Status",?54,"Count",?63,"Percent",!?10,"----------------------------------- ------------ ---------" Q 83 ; 84 LIST(SDI) Q:'$D(^TMP(SDS1,$J,SDS2,SDI)) D:$Y>(IOSL-4) XHDR Q:SDOUT 85 W !?10,$P(^SD(409.63,+SDI,0),U),?47,$J(^TMP(SDS1,$J,SDS2,SDI),12),?62,$J($S(SDCT=0:0,1:(^TMP(SDS1,$J,SDS2,SDI)*100/SDCT)),8,2) 86 Q 87 ; 88 COT D:$Y>(IOSL-4) XHDR Q:SDOUT W !?15,SDSTAT,?47,$J(^TMP(SDS1,$J,SDS2,2,SDI,SDSTAT),12),?62,$J($S(SDCT=0:0,1:(^TMP(SDS1,$J,SDS2,2,SDI,SDSTAT)*100/SDCT)),8,2) Q 89 ; 90 IAP D:$Y>(IOSL-4) XHDR Q:SDOUT W !?15,SDSTAT,?47,$J(^TMP(SDS1,$J,SDS2,"8-CC",SDI,SDSTAT),12),?62,$J($S(SDCT=0:0,1:(^TMP(SDS1,$J,SDS2,"8-CC",SDI,SDSTAT)*100/SDCT)),8,2) Q 91 STOP ;Check for stop task request 92 S:$G(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q 93 ; 94 COUNT ;Count encounters 95 S SDNCOU=$P($G(^SC(+$P(SDOE0,U,4),0)),U,17),SDNCOU=$S(SDNCOU="Y":1,1:0) 96 S SDSTOP=SDSTOP+1 I SDSTOP#3000=0 D STOP Q:SDOUT 97 D C1("SCRPW",SDDNAM) D:SDMD C1("SCRPWD",SDDIV) D:SDCLGR C1("SCRPWC",SDCG) Q 98 ; 99 C1(SDS1,SDS2) ;Set ^TMP global 100 ;Required input: SDS1,SDS2=subscript values 101 ;Because there is only 1 status (8) for INPATIENTS, 8-NC is used to 102 ;distinguish the non-count clinics from the count clinics, 8-CC. 103 S DFN=$P(SDOE0,U,2),SDSTAT=+$P(SDOE0,U,12) I SDSTAT=8 S SDSTAT=$S(SDNCOU:SDSTAT_"-NC",1:SDSTAT_"-CC") 104 I SDZ(0),SDZ(4)=SDDIV,SDS1="SCRPW" D DETAIL 105 S ^TMP(SDS1,$J,SDS2,SDSTAT)=$G(^TMP(SDS1,$J,SDS2,SDSTAT))+1 106 Q:SDSTAT=4 Q:(+SDSTAT=8)&($P(SDSTAT,"-",2)="NC") D:"114238"[+SDSTAT VIS Q 107 ; 108 VIS S ^TMP(SDS1,$J,SDS2,"VISIT",$S(SDSTAT=2:"OWK",(+SDSTAT=8)&('SDNCOU):"OWK",1:"NWK"),DFN,$P(SDDT,"."))="" Q:(+SDSTAT'=2)&(+SDSTAT'=8) 109 I +SDSTAT=8,$P(SDOE0,U,7)="" D Q 110 .S ^TMP(SDS1,$J,SDS2,SDSTAT,10,"Action Required")=$G(^TMP(SDS1,$J,SDS2,SDSTAT,10,"Action Required"))+1 111 S SDSTX=$$STX(SDOE,SDOE0),^TMP(SDS1,$J,SDS2,SDSTAT,$P(SDSTX,U),$P(SDSTX,U,2))=$G(^TMP(SDS1,$J,SDS2,SDSTAT,$P(SDSTX,U),$P(SDSTX,U,2)))+1 112 Q:$P(SDSTX,U)'=8 S ^TMP(SDS1,$J,SDS2,"VISIT","ACC",DFN,$P(SDDT,"."))="" 113 Q 114 ; 115 STX(SDOE,SDOE0) ;Determine transmission status 116 ;Required input: SDOE=OUTPATIENT ENCOUNTER record IFN 117 ;Required input: SDOE0=zeroeth node of OUTPATIENT ENCOUNTER 118 N SDTOE,SDTOEE 119 Q:($P(SDOE0,U,12)'=2)&($P(SDOE0,U,12)'=8) "0^Not checked-out^Not checked-out" 120 S SDTOE=$O(^SD(409.73,"AENC",SDOE,0)) Q:'SDTOE!'$D(^SD(409.73,+SDTOE,0)) "1^No transmission record^No tx. record" 121 S SDTOE1=$G(^SD(409.73,SDTOE,1)),SDTOE0=^SD(409.73,SDTOE,0) I '$P(SDTOE0,U,4),'$P(SDTOE1,U) Q "2^Not required, not transmitted^Not req., not tx." 122 ; SD*5.3*339 added second I SDTOEE below 123 S SDTOEE=$O(^SD(409.75,"B",SDTOE,0)) I SDTOEE S SDTOEE=$P($G(^SD(409.75,SDTOEE,0)),U,2) I SDTOEE S SDTOEE=$P($G(^SD(409.76,SDTOEE,0)),U,2) Q:SDTOEE="V" "3^Rejected for transmission^Rejected for tx." 124 Q:'$P(SDTOE1,U) "4^Awaiting transmission^Awaiting tx." 125 S SDTXS=$P(SDTOE1,U,5) Q:'$L(SDTXS) "5^Transmitted, no acknowledgment^Tx., no ack." 126 Q:SDTXS="R" "6^Transmitted, rejected^Tx., rejected" 127 Q:SDTXS'="A" "7^Transmitted, error^Tx., error" 128 Q "8^Transmitted, accepted^Tx., accepted" 129 ; 130 DETAIL ;Set global for detailed list 131 N SDIF S SDIF=0 132 D ^VADPT S SDPNAM=VADM(1),SDSSN=$P(VADM(2),U) 133 I SDZ(1)="U",+SDSTAT'=4,'SDNCOU S:"114238"[+SDSTAT ^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN,SDSSN)="" Q 134 I SDZ(1)="V",+SDSTAT'=4,'SDNCOU S:"114238"[+SDSTAT ^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN,SDSSN,$P(SDDT,"."))="" Q 135 Q:'$D(SDZ(2)) ; SD*5.3*339 136 I SDZ(2)'=2,SDZ(2)=+SDSTAT D I SDIF Q 137 .I (SDZ(2)=8) Q:$P(SDSTAT,"-",2)="CC" I SDZ(3)'=9 S SDIF=1 Q 138 .D DSET S SDIF=1 139 Q:("28"'[SDZ(2))!("28"'[+SDSTAT) Q:SDZ(2)'=+SDSTAT D I SDIF Q 140 .I +SDSTAT=8,$P(SDSTAT,"-",2)="NC" S SDIF=1 Q 141 .I 'SDZ(3) D DSET S SDIF=1 142 D:+$$STX(SDOE,SDOE0)=SDZ(3) DSET Q 143 ; 144 DSET S ^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN,SDSSN,SDDT,SDOE)=+$P(SDOE0,U,4) Q 1 SCRPW8 ;RENO/KEITH - Outpatient Encounter Workload Statistics ; 04 Feb 99 4:53 PM 2 ;;5.3;Scheduling;**139,145,144,176,339,466**;AUG 13, 1993;Build 2 3 QS ;Queue outpatient encounter workload report 4 D PARM^SCRPW9 Q 5 ; 6 PST ;Print stats 7 N X,Y,% 8 D NOW^%DTC S Y=% X ^DD("DD") S SDPAGE=1,SDPNOW=$P(Y,":",1,2),SDDT=SDDTF,SDMC=$O(^DG(43,0)),SDMC=$G(^DG(43,+SDMC,"GL")),SDMD=$P(SDMC,U,2),(SDOUT,SDSTOP,SDFF)=0 9 S SDDNAM=$P($G(^DG(40.8,+$$PRIM^VASITE(),0)),U,7),SDDNAM=$$GET1^DIQ(4,+SDDNAM,.01) S:'$L(SDDNAM) SDDNAM=$P($G(^DG(40.8,+$P(SDMC,U,3),0)),U) 10 F I="SCRPW","SCRPWD","SCRPWC" K ^TMP(I,$J) 11 F S SDDT=$O(^SCE("B",SDDT)) Q:'SDDT!(SDDT>SDDTL)!SDOUT S SDOE=0 D 12 .F S SDOE=$O(^SCE("B",SDDT,SDOE)) Q:'SDOE!SDOUT S SDOE0=$$GETOE^SDOE(SDOE) I $L(SDOE0),'$P(SDOE0,U,6),$P(SDOE0,U,2),$P(SDOE0,U,11),$P(SDOE0,U,12) S SDDIV=$$DIV(),SDCG=$$CLGR() D COUNT 13 .Q 14 I '$D(^TMP("SCRPW",$J)) D XHDR S SDX="No activity found within the parameters specified." W !!?(80-$L(SDX)\2),SDX G EXIT 15 F SDS1="SCRPW","SCRPWD","SCRPWC" S SDS2="" F S SDS2=$O(^TMP(SDS1,$J,SDS2)) Q:SDS2=""!SDOUT D STCT 16 G:SDOUT EXIT D:$E(IOST)="C" DISP0^SCRPW23 17 F SDS1="SCRPW","SCRPWD","SCRPWC" S SDS2="" F S SDS2=$O(^TMP(SDS1,$J,SDS2)) Q:SDS2=""!SDOUT D PRPT 18 G:SDOUT EXIT 19 D:SDZ(0) DPRT^SCRPW9("SCRPW",SDDNAM) G:SDOUT EXIT D:SDUL UNARL^SCRPW9("SCRPW",SDDNAM) G EXIT 20 ; 21 STCT S (SDUNCO,SDCT,DFN)=0 D STOP Q:SDOUT 22 F S DFN=$O(^TMP(SDS1,$J,SDS2,"VISIT","ACC",DFN)) Q:'DFN S SDUNCO=SDUNCO+1,SDDT=0 F S SDDT=$O(^TMP(SDS1,$J,SDS2,"VISIT","ACC",DFN,SDDT)) Q:'SDDT S SDCT=SDCT+1 23 S ^TMP(SDS1,$J,SDS2,"UNIQUE","UNCO")=SDUNCO,^TMP(SDS1,$J,SDS2,"VISIT","OWK")=SDCT,(SDUNAR,SDCT,DFN)=0 24 S DFN=0 F S DFN=$O(^TMP(SDS1,$J,SDS2,"VISIT","OWK",DFN)) Q:'DFN D NCT1 25 S DFN=0 F S DFN=$O(^TMP(SDS1,$J,SDS2,"VISIT","NWK",DFN)) Q:'DFN D CT1 26 S ^TMP(SDS1,$J,SDS2,"UNIQUE","UNAR")=SDUNAR,^TMP(SDS1,$J,SDS2,"VISIT","NWK")=SDCT Q 27 ; 28 PRPT ;Print statistics page 29 D STOP Q:SDOUT 30 S SDCT=0 F SDI=1,2,3,11,14,8 S SDCT=SDCT+$G(^TMP(SDS1,$J,SDS2,SDI)) 31 D XHDR Q:SDOUT D SHDR("O U T P A T I E N T E N C O U N T E R W O R K L O A D") Q:SDOUT F SDI=11,14,3,1 D LIST(SDI) Q:SDOUT 32 I $D(^TMP(SDS1,$J,SDS2,2)) D:$Y>(IOSL-4) XHDR Q:SDOUT W !?10,"CHECKED OUT" S SDI=0 F S SDI=$O(^TMP(SDS1,$J,SDS2,2,SDI)) Q:'SDI!SDOUT S SDSTAT=$O(^TMP(SDS1,$J,SDS2,2,SDI,"")) D COT 33 I $D(^TMP(SDS1,$J,SDS2,8)) D:$Y>(IOSL-4) XHDR Q:SDOUT W !?10,"INPATIENT APPOINTMENT" S SDI=0 F S SDI=$O(^TMP(SDS1,$J,SDS2,8,SDI)) Q:'SDI!SDOUT S SDSTAT=$O(^TMP(SDS1,$J,SDS2,8,SDI,"")) D IAP 34 D TOT S (SDI,SDCT)=0 F SDI=4,5,6,7,9,12,13 S SDCT=SDCT+$G(^TMP(SDS1,$J,SDS2,SDI)) 35 W !! D SHDR("N O N - W O R K L O A D") Q:SDOUT F SDI=12,4,6,5,7,9,10,13 D LIST(SDI) Q:SDOUT 36 D TOT W !! D SHDR(($$HD2()_" O U T P A T I E N T V I S I T S")) Q:SDOUT S SDCT=^TMP(SDS1,$J,SDS2,"VISIT","NWK")+^TMP(SDS1,$J,SDS2,"VISIT","OWK") 37 D:$Y>(IOSL-4) XHDR Q:SDOUT W !?10,"Act. Req./not accepted visits",?47,$J(^TMP(SDS1,$J,SDS2,"VISIT","NWK"),12),?62,$J($S(SDCT=0:0,1:(^TMP(SDS1,$J,SDS2,"VISIT","NWK")*100/SDCT)),8,2) 38 D:$Y>(IOSL-4) XHDR Q:SDOUT W !?10,"Transmitted, accepted visits",?47,$J(^TMP(SDS1,$J,SDS2,"VISIT","OWK"),12),?62,$J($S(SDCT=0:0,1:(^TMP(SDS1,$J,SDS2,"VISIT","OWK")*100/SDCT)),8,2) 39 D TOT 40 W !! D SHDR(($$HD2()_" O U T P A T I E N T U N I Q U E S")) Q:SDOUT 41 S SDUNCO=^TMP(SDS1,$J,SDS2,"UNIQUE","UNCO"),SDUNAR=^TMP(SDS1,$J,SDS2,"UNIQUE","UNAR"),SDCT=SDUNCO+SDUNAR 42 D:$Y>(IOSL-4) XHDR Q:SDOUT W !?10,"Act. Req./not accepted unique pts.",?47,$J(SDUNAR,12),?62,$J($S(SDCT=0:0,1:SDUNAR*100/SDCT),8,2) 43 D:$Y>(IOSL-4) XHDR Q:SDOUT W !?10,"Transmitted, accepted unique pts.",?47,$J(SDUNCO,12),?62,$J($S(SDCT=0:0,1:SDUNCO*100/SDCT),8,2) D TOT 44 Q 45 ; 46 XHDR I $E(IOST)="C",SDPAGE>1 N DIR S DIR(0)="E" D ^DIR S SDOUT=Y'=1 Q:SDOUT 47 S SDLINE="",$P(SDLINE,"-",81)="" W:SDPAGE>1!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0) W:$X $$XY^SCRPW50("",0,0) W SDLINE,!?15,"<*> OUTPATIENT ENCOUNTER WORKLOAD STATISTICS <*>" 48 I $D(^TMP("SCRPW",$J)) S X=$$HD1() W !?(80-$L(X)\2),X 49 W !,SDLINE,!,"For encounter dates ",SDDTPF," to ",SDDTPL,!,"Date printed: ",SDPNOW,?(74-$L(SDPAGE)),"Page: ",SDPAGE,!,SDLINE,! S SDPAGE=SDPAGE+1 50 Q 51 ; 52 EXIT K SDTOE0,SDUNCO,SDUNAR,SDCT,DFN,SDDT,SDDTF,SDDTL,SDDTPF,SDDTPL,SDI,SDLINE,SDOE,SDOE0,SDPNOW,SDSTAT,SDSTX,SDTOE,SDTOEE,SDTOE1,SDTX,SDTXS,SDX,SDZ,DTOUT,X,Y,ZTDESC,ZTRTN,ZTSAVE 53 D KVA^VADPT K X1,X2,SDH,SDHL,SDPNAM,SDSSN,SDPAGE,SDPT0,SDUL,DUOUT,SDARCT,SDST,SDPNOW,SDMD,SDMC,SDDIV,SDDNAM,SDS1,SDS2,SDCG,SDCLGR F I="SCRPW","SCRPWD","SCRPWC" K ^TMP(I,$J) 54 K I,SDFF,SDOUT,SDSTOP D END^SCRPW50 Q 55 ; 56 HD1() ;Report subheader 1 57 Q $S(SDS1="SCRPW":"For station: ",SDS1="SCRPWD":"For division: ",1:"For clinic group: ")_SDS2 58 ; 59 HD2() ;Report subheader 2 60 Q $S(SDS1="SCRPW":"F A C I L I T Y",SDS1="SCRPWD":"D I V I S I O N",1:"C L I N I C G R O U P") 61 ; 62 DIV() ;Return division name 63 N X S X=$P($G(^DG(40.8,+$P(SDOE0,U,11),0)),U) Q $S('$L(X):"***UNKNOWN***",1:X) 64 ; 65 CLGR() ;Return CLINIC GROUP pointer 66 N X S X=$P($G(^SC(+$P(SDOE0,U,4),0)),U,31),X=$P($G(^SD(409.67,+X,0)),U) Q $S('$L(X):"***NONE ASSIGNED***",1:X) 67 ; 68 NCT1 I '$D(^TMP(SDS1,$J,SDS2,"VISIT","ACC",DFN)) S SDUNAR=SDUNAR+1 D:SDUL&(SDS1="SCRPW") UL("OWK") 69 S SDDT=0 F S SDDT=$O(^TMP(SDS1,$J,SDS2,"VISIT","OWK",DFN,SDDT)) Q:'SDDT I '$D(^TMP(SDS1,$J,SDS2,"VISIT","ACC",DFN,SDDT)) S SDCT=SDCT+1 70 Q 71 ; 72 CT1 I '$D(^TMP(SDS1,$J,SDS2,"VISIT","OWK",DFN)),'$D(^TMP(SDS1,$J,SDS2,"VISIT","ACC",DFN)) S SDUNAR=SDUNAR+1 D:SDUL&(SDS1="SCRPW") UL("NWK") 73 S SDDT=0 F S SDDT=$O(^TMP(SDS1,$J,SDS2,"VISIT","NWK",DFN,SDDT)) Q:'SDDT I '$D(^TMP(SDS1,$J,SDS2,"VISIT","OWK",DFN,SDDT)),'$D(^TMP(SDS1,$J,SDS2,"VISIT","ACC",DFN,SDDT)) S SDCT=SDCT+1 74 Q 75 ; 76 UL(SDI) D ^VADPT S SDDT=0 F S SDDT=$O(^TMP(SDS1,$J,SDS2,"VISIT",SDI,DFN,SDDT)) Q:'SDDT S ^TMP(SDS1,$J,SDS2,"VISIT","UNARL",VADM(1),DFN,$P(VADM(2),U),SDDT)="" 77 Q 78 ; 79 TOT W !?47,"============ =========",!?39,"TOTAL:",?47,$J(SDCT,12),?64,"100.00" Q 80 ; 81 SHDR(SDTX) D:$Y>(IOSL-6) XHDR Q:SDOUT W !!?(80-$L(SDTX)\2),SDTX,!?(80-$L(SDTX)\2) F SDX=1:1:$L(SDTX) W "-" 82 W !!?39,"Status",?54,"Count",?63,"Percent",!?10,"----------------------------------- ------------ ---------" Q 83 ; 84 LIST(SDI) Q:'$D(^TMP(SDS1,$J,SDS2,SDI)) D:$Y>(IOSL-4) XHDR Q:SDOUT 85 W !?10,$P(^SD(409.63,SDI,0),U),?47,$J(^TMP(SDS1,$J,SDS2,SDI),12),?62,$J($S(SDCT=0:0,1:(^TMP(SDS1,$J,SDS2,SDI)*100/SDCT)),8,2) 86 Q 87 ; 88 COT D:$Y>(IOSL-4) XHDR Q:SDOUT W !?15,SDSTAT,?47,$J(^TMP(SDS1,$J,SDS2,2,SDI,SDSTAT),12),?62,$J($S(SDCT=0:0,1:(^TMP(SDS1,$J,SDS2,2,SDI,SDSTAT)*100/SDCT)),8,2) Q 89 ; 90 IAP D:$Y>(IOSL-4) XHDR Q:SDOUT W !?15,SDSTAT,?47,$J(^TMP(SDS1,$J,SDS2,8,SDI,SDSTAT),12),?62,$J($S(SDCT=0:0,1:(^TMP(SDS1,$J,SDS2,8,SDI,SDSTAT)*100/SDCT)),8,2) Q 91 STOP ;Check for stop task request 92 S:$G(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q 93 ; 94 COUNT ;Count encounters 95 S SDSTOP=SDSTOP+1 I SDSTOP#3000=0 D STOP Q:SDOUT 96 D C1("SCRPW",SDDNAM) D:SDMD C1("SCRPWD",SDDIV) D:SDCLGR C1("SCRPWC",SDCG) Q 97 ; 98 C1(SDS1,SDS2) ;Set ^TMP global 99 ;Required input: SDS1,SDS2=subscript values 100 S DFN=$P(SDOE0,U,2),SDSTAT=+$P(SDOE0,U,12) I SDZ(0),SDZ(4)=SDDIV,SDS1="SCRPW" D DETAIL 101 S ^TMP(SDS1,$J,SDS2,SDSTAT)=$G(^TMP(SDS1,$J,SDS2,SDSTAT))+1 102 Q:SDSTAT=4 D:"114238"[SDSTAT VIS Q 103 ; 104 VIS S ^TMP(SDS1,$J,SDS2,"VISIT",$S(SDSTAT=2:"OWK",SDSTAT=8:"OWK",1:"NWK"),DFN,$P(SDDT,"."))="" Q:(SDSTAT'=2)&(SDSTAT'=8) 105 S SDSTX=$$STX(SDOE,SDOE0),^TMP(SDS1,$J,SDS2,SDSTAT,$P(SDSTX,U),$P(SDSTX,U,2))=$G(^TMP(SDS1,$J,SDS2,SDSTAT,$P(SDSTX,U),$P(SDSTX,U,2)))+1 106 Q:$P(SDSTX,U)'=8 S ^TMP(SDS1,$J,SDS2,"VISIT","ACC",DFN,$P(SDDT,"."))="" 107 Q 108 ; 109 STX(SDOE,SDOE0) ;Determine transmission status 110 ;Required input: SDOE=OUTPATIENT ENCOUNTER record IFN 111 ;Required input: SDOE0=zeroeth node of OUTPATIENT ENCOUNTER 112 N SDTOE,SDTOEE 113 Q:($P(SDOE0,U,12)'=2)&($P(SDOE0,U,12)'=8) "0^Not checked-out^Not checked-out" 114 S SDTOE=$O(^SD(409.73,"AENC",SDOE,0)) Q:'SDTOE!'$D(^SD(409.73,+SDTOE,0)) "1^No transmission record^No tx. record" 115 S SDTOE1=$G(^SD(409.73,SDTOE,1)),SDTOE0=^SD(409.73,SDTOE,0) I '$P(SDTOE0,U,4),'$P(SDTOE1,U) Q "2^Not required, not transmitted^Not req., not tx." 116 ; SD*5.3*339 added second I SDTOEE below 117 S SDTOEE=$O(^SD(409.75,"B",SDTOE,0)) I SDTOEE S SDTOEE=$P($G(^SD(409.75,SDTOEE,0)),U,2) I SDTOEE S SDTOEE=$P($G(^SD(409.76,SDTOEE,0)),U,2) Q:SDTOEE="V" "3^Rejected for transmission^Rejected for tx." 118 Q:'$P(SDTOE1,U) "4^Awaiting transmission^Awaiting tx." 119 S SDTXS=$P(SDTOE1,U,5) Q:'$L(SDTXS) "5^Transmitted, no acknowledgment^Tx., no ack." 120 Q:SDTXS="R" "6^Transmitted, rejected^Tx., rejected" 121 Q:SDTXS'="A" "7^Transmitted, error^Tx., error" 122 Q "8^Transmitted, accepted^Tx., accepted" 123 ; 124 DETAIL ;Set global for detailed list 125 D ^VADPT S SDPNAM=VADM(1),SDSSN=$P(VADM(2),U) 126 I SDZ(1)="U",SDSTAT'=4 S:"114238"[SDSTAT ^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN,SDSSN)="" Q 127 I SDZ(1)="V",SDSTAT'=4 S:"114238"[SDSTAT ^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN,SDSSN,$P(SDDT,"."))="" Q 128 Q:'$D(SDZ(2)) ; SD*5.3*339 129 I (SDZ(2)'=2)&(SDZ(2)'=8),SDZ(2)=SDSTAT D DSET Q 130 Q:("28"'[SDZ(2))!("28"'[SDSTAT)!(SDZ(2)'=SDSTAT) I 'SDZ(3) D DSET Q 131 D:+$$STX(SDOE,SDOE0)=SDZ(3) DSET Q 132 ; 133 DSET S ^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN,SDSSN,SDDT,SDOE)=+$P(SDOE0,U,4) Q
Note:
See TracChangeset
for help on using the changeset viewer.
