SCRPW8.m

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 ---SCRPW8   9878     printed  Feb 19, 2025@00:10:38                                                                                                                                                                                                      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