SCRPW8 ;RENO/KEITH - Outpatient Encounter Workload Statistics ; 04 Feb 99 4:53 PM
;;5.3;Scheduling;**139,145,144,176,339,466,510**;AUG 13, 1993;Build 3
QS ;Queue outpatient encounter workload report
D PARM^SCRPW9 Q
;
PST ;Print stats
N X,Y,%
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
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)
F I="SCRPW","SCRPWD","SCRPWC" K ^TMP(I,$J)
F S SDDT=$O(^SCE("B",SDDT)) Q:'SDDT!(SDDT>SDDTL)!SDOUT S SDOE=0 D
.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
.Q
I '$D(^TMP("SCRPW",$J)) D XHDR S SDX="No activity found within the parameters specified." W !!?(80-$L(SDX)\2),SDX G EXIT
F SDS1="SCRPW","SCRPWD","SCRPWC" S SDS2="" F S SDS2=$O(^TMP(SDS1,$J,SDS2)) Q:SDS2=""!SDOUT D STCT
G:SDOUT EXIT D:$E(IOST)="C" DISP0^SCRPW23
F SDS1="SCRPW","SCRPWD","SCRPWC" S SDS2="" F S SDS2=$O(^TMP(SDS1,$J,SDS2)) Q:SDS2=""!SDOUT D PRPT
G:SDOUT EXIT
D:SDZ(0) DPRT^SCRPW9("SCRPW",SDDNAM) G:SDOUT EXIT D:SDUL UNARL^SCRPW9("SCRPW",SDDNAM) G EXIT
;
STCT S (SDUNCO,SDCT,DFN)=0 D STOP Q:SDOUT
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
S ^TMP(SDS1,$J,SDS2,"UNIQUE","UNCO")=SDUNCO,^TMP(SDS1,$J,SDS2,"VISIT","OWK")=SDCT,(SDUNAR,SDCT,DFN)=0
S DFN=0 F S DFN=$O(^TMP(SDS1,$J,SDS2,"VISIT","OWK",DFN)) Q:'DFN D NCT1
S DFN=0 F S DFN=$O(^TMP(SDS1,$J,SDS2,"VISIT","NWK",DFN)) Q:'DFN D CT1
S ^TMP(SDS1,$J,SDS2,"UNIQUE","UNAR")=SDUNAR,^TMP(SDS1,$J,SDS2,"VISIT","NWK")=SDCT Q
;
PRPT ;Print statistics page
D STOP Q:SDOUT
S SDCT=0 F SDI=1,2,3,11,14,"8-CC" S SDCT=SDCT+$G(^TMP(SDS1,$J,SDS2,SDI))
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
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
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
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))
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
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")
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)
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)
D TOT
W !! D SHDR(($$HD2()_" O U T P A T I E N T U N I Q U E S")) Q:SDOUT
S SDUNCO=^TMP(SDS1,$J,SDS2,"UNIQUE","UNCO"),SDUNAR=^TMP(SDS1,$J,SDS2,"UNIQUE","UNAR"),SDCT=SDUNCO+SDUNAR
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)
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
Q
;
XHDR I $E(IOST)="C",SDPAGE>1 N DIR S DIR(0)="E" D ^DIR S SDOUT=Y'=1 Q:SDOUT
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 <*>"
I $D(^TMP("SCRPW",$J)) S X=$$HD1() W !?(80-$L(X)\2),X
W !,SDLINE,!,"For encounter dates ",SDDTPF," to ",SDDTPL,!,"Date printed: ",SDPNOW,?(74-$L(SDPAGE)),"Page: ",SDPAGE,!,SDLINE,! S SDPAGE=SDPAGE+1
Q
;
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
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)
K I,SDFF,SDOUT,SDSTOP,SDNCOU D END^SCRPW50 Q
;
HD1() ;Report subheader 1
Q $S(SDS1="SCRPW":"For station: ",SDS1="SCRPWD":"For division: ",1:"For clinic group: ")_SDS2
;
HD2() ;Report subheader 2
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")
;
DIV() ;Return division name
N X S X=$P($G(^DG(40.8,+$P(SDOE0,U,11),0)),U) Q $S('$L(X):"***UNKNOWN***",1:X)
;
CLGR() ;Return CLINIC GROUP pointer
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)
;
NCT1 I '$D(^TMP(SDS1,$J,SDS2,"VISIT","ACC",DFN)) S SDUNAR=SDUNAR+1 D:SDUL&(SDS1="SCRPW") UL("OWK")
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
Q
;
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")
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
Q
;
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)=""
Q
;
TOT W !?47,"============ =========",!?39,"TOTAL:",?47,$J(SDCT,12),?64,"100.00" Q
;
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 "-"
W !!?39,"Status",?54,"Count",?63,"Percent",!?10,"----------------------------------- ------------ ---------" Q
;
LIST(SDI) Q:'$D(^TMP(SDS1,$J,SDS2,SDI)) D:$Y>(IOSL-4) XHDR Q:SDOUT
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)
Q
;
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
;
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
STOP ;Check for stop task request
S:$G(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
;
COUNT ;Count encounters
S SDNCOU=$P($G(^SC(+$P(SDOE0,U,4),0)),U,17),SDNCOU=$S(SDNCOU="Y":1,1:0)
S SDSTOP=SDSTOP+1 I SDSTOP#3000=0 D STOP Q:SDOUT
D C1("SCRPW",SDDNAM) D:SDMD C1("SCRPWD",SDDIV) D:SDCLGR C1("SCRPWC",SDCG) Q
;
C1(SDS1,SDS2) ;Set ^TMP global
;Required input: SDS1,SDS2=subscript values
;Because there is only 1 status (8) for INPATIENTS, 8-NC is used to
;distinguish the non-count clinics from the count clinics, 8-CC.
S DFN=$P(SDOE0,U,2),SDSTAT=+$P(SDOE0,U,12) I SDSTAT=8 S SDSTAT=$S(SDNCOU:SDSTAT_"-NC",1:SDSTAT_"-CC")
I SDZ(0),SDZ(4)=SDDIV,SDS1="SCRPW" D DETAIL
S ^TMP(SDS1,$J,SDS2,SDSTAT)=$G(^TMP(SDS1,$J,SDS2,SDSTAT))+1
Q:SDSTAT=4 Q:(+SDSTAT=8)&($P(SDSTAT,"-",2)="NC") D:"114238"[+SDSTAT VIS Q
;
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)
I +SDSTAT=8,$P(SDOE0,U,7)="" D Q
.S ^TMP(SDS1,$J,SDS2,SDSTAT,10,"Action Required")=$G(^TMP(SDS1,$J,SDS2,SDSTAT,10,"Action Required"))+1
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
Q:$P(SDSTX,U)'=8 S ^TMP(SDS1,$J,SDS2,"VISIT","ACC",DFN,$P(SDDT,"."))=""
Q
;
STX(SDOE,SDOE0) ;Determine transmission status
;Required input: SDOE=OUTPATIENT ENCOUNTER record IFN
;Required input: SDOE0=zeroeth node of OUTPATIENT ENCOUNTER
N SDTOE,SDTOEE
Q:($P(SDOE0,U,12)'=2)&($P(SDOE0,U,12)'=8) "0^Not checked-out^Not checked-out"
S SDTOE=$O(^SD(409.73,"AENC",SDOE,0)) Q:'SDTOE!'$D(^SD(409.73,+SDTOE,0)) "1^No transmission record^No tx. record"
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."
; SD*5.3*339 added second I SDTOEE below
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."
Q:'$P(SDTOE1,U) "4^Awaiting transmission^Awaiting tx."
S SDTXS=$P(SDTOE1,U,5) Q:'$L(SDTXS) "5^Transmitted, no acknowledgment^Tx., no ack."
Q:SDTXS="R" "6^Transmitted, rejected^Tx., rejected"
Q:SDTXS'="A" "7^Transmitted, error^Tx., error"
Q "8^Transmitted, accepted^Tx., accepted"
;
DETAIL ;Set global for detailed list
N SDIF S SDIF=0
D ^VADPT S SDPNAM=VADM(1),SDSSN=$P(VADM(2),U)
I SDZ(1)="U",+SDSTAT'=4,'SDNCOU S:"114238"[+SDSTAT ^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN,SDSSN)="" Q
I SDZ(1)="V",+SDSTAT'=4,'SDNCOU S:"114238"[+SDSTAT ^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN,SDSSN,$P(SDDT,"."))="" Q
Q:'$D(SDZ(2)) ; SD*5.3*339
I SDZ(2)'=2,SDZ(2)=+SDSTAT D I SDIF Q
.I (SDZ(2)=8) Q:$P(SDSTAT,"-",2)="CC" I SDZ(3)'=9 S SDIF=1 Q
.D DSET S SDIF=1
Q:("28"'[SDZ(2))!("28"'[+SDSTAT) Q:SDZ(2)'=+SDSTAT D I SDIF Q
.I +SDSTAT=8,$P(SDSTAT,"-",2)="NC" S SDIF=1 Q
.I 'SDZ(3) D DSET S SDIF=1
D:+$$STX(SDOE,SDOE0)=SDZ(3) DSET Q
;
DSET S ^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN,SDSSN,SDDT,SDOE)=+$P(SDOE0,U,4) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPW8 9878 printed Nov 22, 2024@17:54:08 Page 2
SCRPW8 ;RENO/KEITH - Outpatient Encounter Workload Statistics ; 04 Feb 99 4:53 PM
+1 ;;5.3;Scheduling;**139,145,144,176,339,466,510**;AUG 13, 1993;Build 3
QS ;Queue outpatient encounter workload report
+1 DO PARM^SCRPW9
QUIT
+2 ;
PST ;Print stats
+1 NEW X,Y,%
+2 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET SDPAGE=1
SET SDPNOW=$PIECE(Y,":",1,2)
SET SDDT=SDDTF
SET SDMC=$ORDER(^DG(43,0))
SET SDMC=$GET(^DG(43,+SDMC,"GL"))
SET SDMD=$PIECE(SDMC,U,2)
SET (SDOUT,SDSTOP,SDFF)=0
+3 SET SDDNAM=$PIECE($GET(^DG(40.8,+$$PRIM^VASITE(),0)),U,7)
SET SDDNAM=$$GET1^DIQ(4,+SDDNAM,.01)
if '$LENGTH(SDDNAM)
SET SDDNAM=$PIECE($GET(^DG(40.8,+$PIECE(SDMC,U,3),0)),U)
+4 FOR I="SCRPW","SCRPWD","SCRPWC"
KILL ^TMP(I,$JOB)
+5 FOR
SET SDDT=$ORDER(^SCE("B",SDDT))
if 'SDDT!(SDDT>SDDTL)!SDOUT
QUIT
SET SDOE=0
Begin DoDot:1
+6 FOR
SET SDOE=$ORDER(^SCE("B",SDDT,SDOE))
if 'SDOE!SDOUT
QUIT
SET SDOE0=$$GETOE^SDOE(SDOE)
IF $LENGTH(SDOE0)
IF '$PIECE(SDOE0,U,6)
IF $PIECE(SDOE0,U,2)
IF $PIECE(SDOE0,U,11)
IF $PIECE(SDOE0,U,12)
SET SDDIV=$$DIV()
SET SDCG=$$CLGR()
DO COUNT
+7 QUIT
End DoDot:1
+8 IF '$DATA(^TMP("SCRPW",$JOB))
DO XHDR
SET SDX="No activity found within the parameters specified."
WRITE !!?(80-$LENGTH(SDX)\2),SDX
GOTO EXIT
+9 FOR SDS1="SCRPW","SCRPWD","SCRPWC"
SET SDS2=""
FOR
SET SDS2=$ORDER(^TMP(SDS1,$JOB,SDS2))
if SDS2=""!SDOUT
QUIT
DO STCT
+10 if SDOUT
GOTO EXIT
if $EXTRACT(IOST)="C"
DO DISP0^SCRPW23
+11 FOR SDS1="SCRPW","SCRPWD","SCRPWC"
SET SDS2=""
FOR
SET SDS2=$ORDER(^TMP(SDS1,$JOB,SDS2))
if SDS2=""!SDOUT
QUIT
DO PRPT
+12 if SDOUT
GOTO EXIT
+13 if SDZ(0)
DO DPRT^SCRPW9("SCRPW",SDDNAM)
if SDOUT
GOTO EXIT
if SDUL
DO UNARL^SCRPW9("SCRPW",SDDNAM)
GOTO EXIT
+14 ;
STCT SET (SDUNCO,SDCT,DFN)=0
DO STOP
if SDOUT
QUIT
+1 FOR
SET DFN=$ORDER(^TMP(SDS1,$JOB,SDS2,"VISIT","ACC",DFN))
if 'DFN
QUIT
SET SDUNCO=SDUNCO+1
SET SDDT=0
FOR
SET SDDT=$ORDER(^TMP(SDS1,$JOB,SDS2,"VISIT","ACC",DFN,SDDT))
if 'SDDT
QUIT
SET SDCT=SDCT+1
+2 SET ^TMP(SDS1,$JOB,SDS2,"UNIQUE","UNCO")=SDUNCO
SET ^TMP(SDS1,$JOB,SDS2,"VISIT","OWK")=SDCT
SET (SDUNAR,SDCT,DFN)=0
+3 SET DFN=0
FOR
SET DFN=$ORDER(^TMP(SDS1,$JOB,SDS2,"VISIT","OWK",DFN))
if 'DFN
QUIT
DO NCT1
+4 SET DFN=0
FOR
SET DFN=$ORDER(^TMP(SDS1,$JOB,SDS2,"VISIT","NWK",DFN))
if 'DFN
QUIT
DO CT1
+5 SET ^TMP(SDS1,$JOB,SDS2,"UNIQUE","UNAR")=SDUNAR
SET ^TMP(SDS1,$JOB,SDS2,"VISIT","NWK")=SDCT
QUIT
+6 ;
PRPT ;Print statistics page
+1 DO STOP
if SDOUT
QUIT
+2 SET SDCT=0
FOR SDI=1,2,3,11,14,"8-CC"
SET SDCT=SDCT+$GET(^TMP(SDS1,$JOB,SDS2,SDI))
+3 DO XHDR
if SDOUT
QUIT
DO 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")
if SDOUT
QUIT
FOR SDI=11,14,3,1
DO LIST(SDI)
if SDOUT
QUIT
+4 IF $DATA(^TMP(SDS1,$JOB,SDS2,2))
if $Y>(IOSL-4)
DO XHDR
if SDOUT
QUIT
WRITE !?10,"CHECKED OUT"
SET SDI=0
FOR
SET SDI=$ORDER(^TMP(SDS1,$JOB,SDS2,2,SDI))
if 'SDI!SDOUT
QUIT
SET SDSTAT=$ORDER(^TMP(SDS1,$JOB,SDS2,2,SDI,""))
DO COT
+5 IF $DATA(^TMP(SDS1,$JOB,SDS2,"8-CC"))
if $Y>(IOSL-4)
DO XHDR
if SDOUT
QUIT
WRITE !?10,"INPATIENT APPOINTMENT"
SET SDI=0
FOR
SET SDI=$ORDER(^TMP(SDS1,$JOB,SDS2,"8-CC",SDI))
if 'SDI!SDOUT
QUIT
SET SDSTAT=$ORDER(^TMP(SDS1,$JOB,SDS2,"8-CC",SDI,""))
DO IAP
+6 DO TOT
SET (SDI,SDCT)=0
FOR SDI=4,5,6,7,"8-NC",9,12,13
SET SDCT=SDCT+$GET(^TMP(SDS1,$JOB,SDS2,SDI))
+7 WRITE !!
DO SHDR("N O N - W O R K L O A D")
if SDOUT
QUIT
FOR SDI="8-NC",12,4,6,5,7,9,10,13
DO LIST(SDI)
if SDOUT
QUIT
+8 DO TOT
WRITE !!
DO SHDR(($$HD2()_" O U T P A T I E N T V I S I T S"))
if SDOUT
QUIT
SET SDCT=^TMP(SDS1,$JOB,SDS2,"VISIT","NWK")+^TMP(SDS1,$JOB,SDS2,"VISIT","OWK")
+9 if $Y>(IOSL-4)
DO XHDR
if SDOUT
QUIT
WRITE !?10,"Act. Req./not accepted visits",?47,$JUSTIFY(^TMP(SDS1,$JOB,SDS2,"VISIT","NWK"),12),?62,$JUSTIFY($SELECT(SDCT=0:0,1:(^TMP(SDS1,$JOB,SDS2,"VISIT","NWK")*100/SDCT)),8,2)
+10 if $Y>(IOSL-4)
DO XHDR
if SDOUT
QUIT
WRITE !?10,"Transmitted, accepted visits",?47,$JUSTIFY(^TMP(SDS1,$JOB,SDS2,"VISIT","OWK"),12),?62,$JUSTIFY($SELECT(SDCT=0:0,1:(^TMP(SDS1,$JOB,SDS2,"VISIT","OWK")*100/SDCT)),8,2)
+11 DO TOT
+12 WRITE !!
DO SHDR(($$HD2()_" O U T P A T I E N T U N I Q U E S"))
if SDOUT
QUIT
+13 SET SDUNCO=^TMP(SDS1,$JOB,SDS2,"UNIQUE","UNCO")
SET SDUNAR=^TMP(SDS1,$JOB,SDS2,"UNIQUE","UNAR")
SET SDCT=SDUNCO+SDUNAR
+14 if $Y>(IOSL-4)
DO XHDR
if SDOUT
QUIT
WRITE !?10,"Act. Req./not accepted unique pts.",?47,$JUSTIFY(SDUNAR,12),?62,$JUSTIFY($SELECT(SDCT=0:0,1:SDUNAR*100/SDCT),8,2)
+15 if $Y>(IOSL-4)
DO XHDR
if SDOUT
QUIT
WRITE !?10,"Transmitted, accepted unique pts.",?47,$JUSTIFY(SDUNCO,12),?62,$JUSTIFY($SELECT(SDCT=0:0,1:SDUNCO*100/SDCT),8,2)
DO TOT
+16 QUIT
+17 ;
XHDR IF $EXTRACT(IOST)="C"
IF SDPAGE>1
NEW DIR
SET DIR(0)="E"
DO ^DIR
SET SDOUT=Y'=1
if SDOUT
QUIT
+1 SET SDLINE=""
SET $PIECE(SDLINE,"-",81)=""
if SDPAGE>1!($EXTRACT(IOST)="C")
WRITE $$XY^SCRPW50(IOF,1,0)
if $X
WRITE $$XY^SCRPW50("",0,0)
WRITE SDLINE,!?15,"<*> OUTPATIENT ENCOUNTER WORKLOAD STATISTICS <*>"
+2 IF $DATA(^TMP("SCRPW",$JOB))
SET X=$$HD1()
WRITE !?(80-$LENGTH(X)\2),X
+3 WRITE !,SDLINE,!,"For encounter dates ",SDDTPF," to ",SDDTPL,!,"Date printed: ",SDPNOW,?(74-$LENGTH(SDPAGE)),"Page: ",SDPAGE,!,SDLINE,!
SET SDPAGE=SDPAGE+1
+4 QUIT
+5 ;
EXIT KILL 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
+1 DO KVA^VADPT
KILL X1,X2,SDH,SDHL,SDPNAM,SDSSN,SDPAGE,SDPT0,SDUL,DUOUT,SDARCT,SDST,SDPNOW,SDMD,SDMC,SDDIV,SDDNAM,SDS1,SDS2,SDCG,SDCLGR
FOR I="SCRPW","SCRPWD","SCRPWC"
KILL ^TMP(I,$JOB)
+2 KILL I,SDFF,SDOUT,SDSTOP,SDNCOU
DO END^SCRPW50
QUIT
+3 ;
HD1() ;Report subheader 1
+1 QUIT $SELECT(SDS1="SCRPW":"For station: ",SDS1="SCRPWD":"For division: ",1:"For clinic group: ")_SDS2
+2 ;
HD2() ;Report subheader 2
+1 QUIT $SELECT(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")
+2 ;
DIV() ;Return division name
+1 NEW X
SET X=$PIECE($GET(^DG(40.8,+$PIECE(SDOE0,U,11),0)),U)
QUIT $SELECT('$LENGTH(X):"***UNKNOWN***",1:X)
+2 ;
CLGR() ;Return CLINIC GROUP pointer
+1 NEW X
SET X=$PIECE($GET(^SC(+$PIECE(SDOE0,U,4),0)),U,31)
SET X=$PIECE($GET(^SD(409.67,+X,0)),U)
QUIT $SELECT('$LENGTH(X):"***NONE ASSIGNED***",1:X)
+2 ;
NCT1 IF '$DATA(^TMP(SDS1,$JOB,SDS2,"VISIT","ACC",DFN))
SET SDUNAR=SDUNAR+1
if SDUL&(SDS1="SCRPW")
DO UL("OWK")
+1 SET SDDT=0
FOR
SET SDDT=$ORDER(^TMP(SDS1,$JOB,SDS2,"VISIT","OWK",DFN,SDDT))
if 'SDDT
QUIT
IF '$DATA(^TMP(SDS1,$JOB,SDS2,"VISIT","ACC",DFN,SDDT))
SET SDCT=SDCT+1
+2 QUIT
+3 ;
CT1 IF '$DATA(^TMP(SDS1,$JOB,SDS2,"VISIT","OWK",DFN))
IF '$DATA(^TMP(SDS1,$JOB,SDS2,"VISIT","ACC",DFN))
SET SDUNAR=SDUNAR+1
if SDUL&(SDS1="SCRPW")
DO UL("NWK")
+1 SET SDDT=0
FOR
SET SDDT=$ORDER(^TMP(SDS1,$JOB,SDS2,"VISIT","NWK",DFN,SDDT))
if 'SDDT
QUIT
IF '$DATA(^TMP(SDS1,$JOB,SDS2,"VISIT","OWK",DFN,SDDT))
IF '$DATA(^TMP(SDS1,$JOB,SDS2,"VISIT","ACC",DFN,SDDT))
SET SDCT=SDCT+1
+2 QUIT
+3 ;
UL(SDI) DO ^VADPT
SET SDDT=0
FOR
SET SDDT=$ORDER(^TMP(SDS1,$JOB,SDS2,"VISIT",SDI,DFN,SDDT))
if 'SDDT
QUIT
SET ^TMP(SDS1,$JOB,SDS2,"VISIT","UNARL",VADM(1),DFN,$PIECE(VADM(2),U),SDDT)=""
+1 QUIT
+2 ;
TOT WRITE !?47,"============ =========",!?39,"TOTAL:",?47,$JUSTIFY(SDCT,12),?64,"100.00"
QUIT
+1 ;
SHDR(SDTX) if $Y>(IOSL-6)
DO XHDR
if SDOUT
QUIT
WRITE !!?(80-$LENGTH(SDTX)\2),SDTX,!?(80-$LENGTH(SDTX)\2)
FOR SDX=1:1:$LENGTH(SDTX)
WRITE "-"
+1 WRITE !!?39,"Status",?54,"Count",?63,"Percent",!?10,"----------------------------------- ------------ ---------"
QUIT
+2 ;
LIST(SDI) if '$DATA(^TMP(SDS1,$JOB,SDS2,SDI))
QUIT
if $Y>(IOSL-4)
DO XHDR
if SDOUT
QUIT
+1 WRITE !?10,$PIECE(^SD(409.63,+SDI,0),U),?47,$JUSTIFY(^TMP(SDS1,$JOB,SDS2,SDI),12),?62,$JUSTIFY($SELECT(SDCT=0:0,1:(^TMP(SDS1,$JOB,SDS2,SDI)*100/SDCT)),8,2)
+2 QUIT
+3 ;
COT if $Y>(IOSL-4)
DO XHDR
if SDOUT
QUIT
WRITE !?15,SDSTAT,?47,$JUSTIFY(^TMP(SDS1,$JOB,SDS2,2,SDI,SDSTAT),12),?62,$JUSTIFY($SELECT(SDCT=0:0,1:(^TMP(SDS1,$JOB,SDS2,2,SDI,SDSTAT)*100/SDCT)),8,2)
QUIT
+1 ;
IAP if $Y>(IOSL-4)
DO XHDR
if SDOUT
QUIT
WRITE !?15,SDSTAT,?47,$JUSTIFY(^TMP(SDS1,$JOB,SDS2,"8-CC",SDI,SDSTAT),12),?62,$JUSTIFY($SELECT(SDCT=0:0,1:(^TMP(SDS1,$JOB,SDS2,"8-CC",SDI,SDSTAT)*100/SDCT)),8,2)
QUIT
STOP ;Check for stop task request
+1 if $GET(ZTQUEUED)
SET (SDOUT,ZTSTOP)=$SELECT($$S^%ZTLOAD:1,1:0)
QUIT
+2 ;
COUNT ;Count encounters
+1 SET SDNCOU=$PIECE($GET(^SC(+$PIECE(SDOE0,U,4),0)),U,17)
SET SDNCOU=$SELECT(SDNCOU="Y":1,1:0)
+2 SET SDSTOP=SDSTOP+1
IF SDSTOP#3000=0
DO STOP
if SDOUT
QUIT
+3 DO C1("SCRPW",SDDNAM)
if SDMD
DO C1("SCRPWD",SDDIV)
if SDCLGR
DO C1("SCRPWC",SDCG)
QUIT
+4 ;
C1(SDS1,SDS2) ;Set ^TMP global
+1 ;Required input: SDS1,SDS2=subscript values
+2 ;Because there is only 1 status (8) for INPATIENTS, 8-NC is used to
+3 ;distinguish the non-count clinics from the count clinics, 8-CC.
+4 SET DFN=$PIECE(SDOE0,U,2)
SET SDSTAT=+$PIECE(SDOE0,U,12)
IF SDSTAT=8
SET SDSTAT=$SELECT(SDNCOU:SDSTAT_"-NC",1:SDSTAT_"-CC")
+5 IF SDZ(0)
IF SDZ(4)=SDDIV
IF SDS1="SCRPW"
DO DETAIL
+6 SET ^TMP(SDS1,$JOB,SDS2,SDSTAT)=$GET(^TMP(SDS1,$JOB,SDS2,SDSTAT))+1
+7 if SDSTAT=4
QUIT
if (+SDSTAT=8)&($PIECE(SDSTAT,"-",2)="NC")
QUIT
if "114238"[+SDSTAT
DO VIS
QUIT
+8 ;
VIS SET ^TMP(SDS1,$JOB,SDS2,"VISIT",$SELECT(SDSTAT=2:"OWK",(+SDSTAT=8)&('SDNCOU):"OWK",1:"NWK"),DFN,$PIECE(SDDT,"."))=""
if (+SDSTAT'=2)&(+SDSTAT'=8)
QUIT
+1 IF +SDSTAT=8
IF $PIECE(SDOE0,U,7)=""
Begin DoDot:1
+2 SET ^TMP(SDS1,$JOB,SDS2,SDSTAT,10,"Action Required")=$GET(^TMP(SDS1,$JOB,SDS2,SDSTAT,10,"Action Required"))+1
End DoDot:1
QUIT
+3 SET SDSTX=$$STX(SDOE,SDOE0)
SET ^TMP(SDS1,$JOB,SDS2,SDSTAT,$PIECE(SDSTX,U),$PIECE(SDSTX,U,2))=$GET(^TMP(SDS1,$JOB,SDS2,SDSTAT,$PIECE(SDSTX,U),$PIECE(SDSTX,U,2)))+1
+4 if $PIECE(SDSTX,U)'=8
QUIT
SET ^TMP(SDS1,$JOB,SDS2,"VISIT","ACC",DFN,$PIECE(SDDT,"."))=""
+5 QUIT
+6 ;
STX(SDOE,SDOE0) ;Determine transmission status
+1 ;Required input: SDOE=OUTPATIENT ENCOUNTER record IFN
+2 ;Required input: SDOE0=zeroeth node of OUTPATIENT ENCOUNTER
+3 NEW SDTOE,SDTOEE
+4 if ($PIECE(SDOE0,U,12)'=2)&($PIECE(SDOE0,U,12)'=8)
QUIT "0^Not checked-out^Not checked-out"
+5 SET SDTOE=$ORDER(^SD(409.73,"AENC",SDOE,0))
if 'SDTOE!'$DATA(^SD(409.73,+SDTOE,0))
QUIT "1^No transmission record^No tx. record"
+6 SET SDTOE1=$GET(^SD(409.73,SDTOE,1))
SET SDTOE0=^SD(409.73,SDTOE,0)
IF '$PIECE(SDTOE0,U,4)
IF '$PIECE(SDTOE1,U)
QUIT "2^Not required, not transmitted^Not req., not tx."
+7 ; SD*5.3*339 added second I SDTOEE below
+8 SET SDTOEE=$ORDER(^SD(409.75,"B",SDTOE,0))
IF SDTOEE
SET SDTOEE=$PIECE($GET(^SD(409.75,SDTOEE,0)),U,2)
IF SDTOEE
SET SDTOEE=$PIECE($GET(^SD(409.76,SDTOEE,0)),U,2)
if SDTOEE="V"
QUIT "3^Rejected for transmission^Rejected for tx."
+9 if '$PIECE(SDTOE1,U)
QUIT "4^Awaiting transmission^Awaiting tx."
+10 SET SDTXS=$PIECE(SDTOE1,U,5)
if '$LENGTH(SDTXS)
QUIT "5^Transmitted, no acknowledgment^Tx., no ack."
+11 if SDTXS="R"
QUIT "6^Transmitted, rejected^Tx., rejected"
+12 if SDTXS'="A"
QUIT "7^Transmitted, error^Tx., error"
+13 QUIT "8^Transmitted, accepted^Tx., accepted"
+14 ;
DETAIL ;Set global for detailed list
+1 NEW SDIF
SET SDIF=0
+2 DO ^VADPT
SET SDPNAM=VADM(1)
SET SDSSN=$PIECE(VADM(2),U)
+3 IF SDZ(1)="U"
IF +SDSTAT'=4
IF 'SDNCOU
if "114238"[+SDSTAT
SET ^TMP(SDS1,$JOB,SDS2,"DETAIL",SDPNAM,DFN,SDSSN)=""
QUIT
+4 IF SDZ(1)="V"
IF +SDSTAT'=4
IF 'SDNCOU
if "114238"[+SDSTAT
SET ^TMP(SDS1,$JOB,SDS2,"DETAIL",SDPNAM,DFN,SDSSN,$PIECE(SDDT,"."))=""
QUIT
+5 ; SD*5.3*339
if '$DATA(SDZ(2))
QUIT
+6 IF SDZ(2)'=2
IF SDZ(2)=+SDSTAT
Begin DoDot:1
+7 IF (SDZ(2)=8)
if $PIECE(SDSTAT,"-",2)="CC"
QUIT
IF SDZ(3)'=9
SET SDIF=1
QUIT
+8 DO DSET
SET SDIF=1
End DoDot:1
IF SDIF
QUIT
+9 if ("28"'[SDZ(2))!("28"'[+SDSTAT)
QUIT
if SDZ(2)'=+SDSTAT
QUIT
Begin DoDot:1
+10 IF +SDSTAT=8
IF $PIECE(SDSTAT,"-",2)="NC"
SET SDIF=1
QUIT
+11 IF 'SDZ(3)
DO DSET
SET SDIF=1
End DoDot:1
IF SDIF
QUIT
+12 if +$$STX(SDOE,SDOE0)=SDZ(3)
DO DSET
QUIT
+13 ;
DSET SET ^TMP(SDS1,$JOB,SDS2,"DETAIL",SDPNAM,DFN,SDSSN,SDDT,SDOE)=+$PIECE(SDOE0,U,4)
QUIT
