SCRPW9 ;RENO/KEITH - Outpatient Encounter Workload Statistics (cont.) ; 15 Jul 98 02:38PM
;;5.3;Scheduling;**139,144,339,466,510,1015**;AUG 13, 1993;Build 21
UNARL(SDS1,SDS2) ;Print list of 'action required'/not accepted uniques
;Required input: SDS1,SDS2=subscript values
S SDPAGE=1 D UHDR Q:SDOUT I '$D(^TMP(SDS1,$J,SDS2,"VISIT","UNARL")) W !!,"No 'action required'/not accepted unique patients identified." Q
S SDARCT=0,SDPNAM="" F S SDPNAM=$O(^TMP(SDS1,$J,SDS2,"VISIT","UNARL",SDPNAM)) Q:SDPNAM=""!SDOUT S DFN=0 F S DFN=$O(^TMP(SDS1,$J,SDS2,"VISIT","UNARL",SDPNAM,DFN)) Q:'DFN!SDOUT D UNP
Q:SDOUT D:$Y>(IOSL-3) UHDR Q:SDOUT W !!,SDARCT," 'action required'/not accepted unique patient",$S(SDARCT=1:"",1:"s")," identified." Q
;
UNP S SDSSN=$O(^TMP(SDS1,$J,SDS2,"VISIT","UNARL",SDPNAM,DFN,"")) D:$Y>(IOSL-4) UHDR Q:SDOUT W !,$E(SDPNAM,1,18),?20,SDSSN
S SDARCT=SDARCT+1,(SDDT,SDI)=0 F S SDDT=$O(^TMP(SDS1,$J,SDS2,"VISIT","UNARL",SDPNAM,DFN,SDSSN,SDDT)) Q:'SDDT!SDOUT D:$Y>(IOSL-4) UHDR Q:SDOUT S Y=SDDT X ^DD("DD") W:SDI ! W ?31,Y S SDI=1 D UNP1
Q
;
UNP1 N SDII,SDDT1 S SDII=0,SDDT1=SDDT F S SDDT1=$O(^SCE("ADFN",DFN,SDDT1)) Q:'SDDT1!(SDDT1>(SDDT+.9999))!SDOUT D
.S SDOE=0 F S SDOE=$O(^SCE("ADFN",DFN,SDDT1,SDOE)) Q:'SDOE!SDOUT S SDOE0=$$GETOE^SDOE(SDOE) I $L(SDOE0),'$P(SDOE0,U,6) D UNP2
.Q
Q
;
UNP2 N SDCL,SDST Q:'$P(SDOE0,U,4) S SDCL=$P($G(^SC($P(SDOE0,U,4),0)),U),SDST=$P(SDOE0,U,12) Q:$P($G(^SC($P(SDOE0,U,4),0)),U,17)="Y" Q:'SDST!(SDST=12) S SDST=$S("28"'[SDST:$P(^SD(409.63,SDST,0),U),1:$P($$STX^SCRPW8(SDOE,SDOE0),U,3))
D:$Y>(IOSL-4) UHDR Q:SDOUT W:SDII ! W ?44,$E(SDCL,1,17),?63,$E(SDST,1,17) S SDII=SDII+1 Q
;
UHDR I $E(IOST)="C" N DIR S DIR(0)="E" D ^DIR S SDOUT=Y'=1 Q:SDOUT
D STOP^SCRPW8 Q:SDOUT
W $$XY^SCRPW50(IOF,1,0),SDLINE,!?8,"<*> LIST OF 'ACTION REQUIRED'/NOT ACCEPTED UNIQUE PATIENTS <*>",!?(66-$L(SDDNAM)\2),"For station: ",SDDNAM
W !,SDLINE,!,"For encounter dates ",SDDTPF," to ",SDDTPL,!,"Date printed: ",SDPNOW,?(74-$L(SDPAGE)),"Page: ",SDPAGE,!,SDLINE,! S SDPAGE=SDPAGE+1
W:$D(^TMP(SDS1,$J,SDS2,"VISIT","UNARL")) !,"Name:",?20,"SSN:",?31,"Date:",?44,"Location:",?63,"Reason:",! Q
;
DETAIL ;Ask questions for detail of encounters or uniques for a division
K SDZ S SDZ(0)=0 K DIR S DIR(0)="Y",DIR("A")="Would you like to print a detailed list of activity for a division",DIR("B")="NO" W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDZ(0)=-1 Q
S SDZ(0)=Y Q:'Y W !!!,$C(7)," WARNING: Selection high activity areas will result in lengthy output!",!
K DIR S DIR(0)="S^U:UNIQUES;V:VISITS;E:ENCOUNTERS",DIR("A")="Select type of list" D ^DIR I $D(DTOUT)!$D(DUOUT) S SDZ(0)=-1 Q
S SDZ(1)=Y G:Y'="E" ZDIV
DET1 K DIC S DIC="^SD(409.63,",DIC(0)="AEMQ",DIC("S")="I Y<4!(Y=8!(Y=12!(Y=14)))",DIC("A")="Select encounter status: " W ! D ^DIC I $D(DTOUT)!$D(DUOUT)!($G(Y)<1) S SDZ(0)=-1 Q
S SDZ(2)=$P(Y,U) G:(SDZ(2)'=2)&(SDZ(2)'=8) ZDIV K DIR S DIR("A")="Select transmission status for "_$S(SDZ(2)=2:"CHECKED OUT",1:"INPATIENT APPOINTMENT")_" encounters"
S DIR(0)="S^A:All transmission statuses;1:No transmission record;2:Not required, not transmitted;3:Rejected for transmission;4:Awaiting transmission;"
S DIR(0)=DIR(0)_"5:Transmitted, no acknowledgment;6:Transmitted, rejected;7:Transmitted, error;8:Transmitted, accepted"
I SDZ(2)=8 S DIR(0)=DIR(0)_";9:Non-Count (not transmitted)"
W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDZ(0)=-1 Q ;SD*5.3*339 add sub-zero
S SDZ(3)=+Y
ZDIV ;Get division for detail
I '$P($G(^DG(43,1,"GL")),U,2) S SDZ(4)=$P(^DG(40.8,$$PRIM^VASITE(),0),U) Q
K DIC S DIC="^DG(40.8,",DIC("A")="Select Medical Center division for detail: ",DIC(0)="AEMQ" W ! D ^DIC I $D(DTOUT)!$D(DUOUT) S SDZ(0)=-1 Q
I Y<1 W $C(7)," Required for patient detail!" G ZDIV
S SDZ(4)=$P(Y,U,2) Q
;
DPRT(SDS1,SDS2) ;Detail print
;Required input: SDS1,SDS2=subscript values
K SDH S SDPAGE=1,SDH(1)="<*> DETAILED LIST OF DIVISION "_$S(SDZ(1)="U":"UNIQUES",SDZ(1)="V":"VISITS",1:"ENCOUNTERS")_" <*>",SDH(2)="For division: "_SDZ(4)
I $G(SDZ(2)) S SDH(3)="Encounters with "_$P(^SD(409.63,SDZ(2),0),U)_" status"
I $G(SDZ(2))'="","28"[SDZ(2) S SDH(4)="Transmission status: "_$P($T(TXS+SDZ(3)),";",2)
D DHDR Q:SDOUT I '$D(^TMP(SDS1,$J,SDS2,"DETAIL")) W !,"No records found in this category." Q
S SDCT=0 D @SDZ(1) Q
;
U ;Print uniques
S SDPNAM="" F S SDPNAM=$O(^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM)) Q:SDPNAM=""!SDOUT S DFN=0 F S DFN=$O(^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN)) Q:'DFN!SDOUT D U1
Q:SDOUT W !!,SDCT," uniques identified." Q
;
U1 S SDCT=SDCT+1,SDSSN=$O(^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN,"")) D:$Y>(IOSL-4) DHDR Q:SDOUT W !,$E(SDPNAM,1,18),?21,SDSSN Q
;
V ;Print visits
S SDPNAM="" F S SDPNAM=$O(^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM)) Q:SDPNAM=""!SDOUT S DFN=0 F S DFN=$O(^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN)) Q:'DFN!SDOUT S SDSSN=$O(^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN,"")) D V1
Q:SDOUT W !!,SDCT," visits identified." Q
;
V1 D:$Y>(IOSL-4) DHDR Q:SDOUT W !,$E(SDPNAM,1,18),?21,SDSSN S (SDDT,SDI)=0 F S SDDT=$O(^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN,SDSSN,SDDT)) Q:'SDDT!SDOUT D
.D:$Y>(IOSL-3) DHDR Q:SDOUT S Y=SDDT X ^DD("DD") W:SDI ! W ?32,Y S SDCT=SDCT+1,SDI=SDI+1
.Q
Q
;
E ;Print encounters
S SDPNAM="" F S SDPNAM=$O(^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM)) Q:SDPNAM=""!SDOUT S DFN=0 F S DFN=$O(^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN)) Q:'DFN!SDOUT S SDSSN=$O(^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN,"")) D E1
Q:SDOUT W !!,SDCT," encounters identified." Q
;
E1 D:$Y>(IOSL-4) DHDR Q:SDOUT W !,$E(SDPNAM,1,18),?21,SDSSN
S (SDDT,SDI)=0 F S SDDT=$O(^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN,SDSSN,SDDT)) Q:'SDDT!SDOUT S SDOE=0 F S SDOE=$O(^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN,SDSSN,SDDT,SDOE)) Q:'SDOE!SDOUT D E2
Q
;
E2 D:$Y>(IOSL-3) DHDR Q:SDOUT S SDHL=^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN,SDSSN,SDDT,SDOE),SDHL=$P($G(^SC(+SDHL,0)),U),Y=SDDT X ^DD("DD") W:SDI ! W ?32,$P(Y,":",1,2),?50,SDHL S SDCT=SDCT+1,SDI=SDI+1 Q
;
DHDR I $E(IOST)="C" N DIR S DIR(0)="E" D ^DIR S SDOUT=Y'=1 Q:SDOUT
D STOP^SCRPW8 Q:SDOUT
W $$XY^SCRPW50(IOF,1,0),SDLINE S I=0 F S I=$O(SDH(I)) Q:'I W !?(80-$L(SDH(I))\2),SDH(I)
W !,SDLINE,!,"For date range: ",SDDTPF," to ",SDDTPL,!,"Date printed: ",SDPNOW,?(74-$L(SDPAGE)),"Page: ",SDPAGE,!,SDLINE,! S SDPAGE=SDPAGE+1 Q
;
TXS ;All transmission statuses
;No transmission record
;Not required, not transmitted
;Rejected for transmission
;Awaiting transmission
;Transmitted, no acknowledgment
;Transmitted, rejected
;Transmitted, error
;Transmitted, accepted
;Non-Count (not transmitted)
;
PARM ;Prompt for report parameters
D TITL^SCRPW50("Outpatient Encounter Workload Statistics")
N %DT,DIR,DIC D SUBT^SCRPW50("*** Date Range Selection ***")
FDT W ! S %DT="AEPX",%DT("A")="Beginning date: FIRST// ",%DT(0)=2961001 D ^%DT G:X=U!$D(DTOUT) EXIT^SCRPW8 I X="" S (Y,SDDTF)=2961001 X ^DD("DD") W " ",Y,! S SDDTPF=Y G LDT
G:Y<1 FDT S SDDTF=Y X ^DD("DD") S SDDTPF=Y W !
LDT S %DT("A")="Ending date: LAST// " D ^%DT G:X=U!$D(DTOUT) EXIT^SCRPW8 I X="" S X1=DT,X2=-1 D C^%DTC S (Y,SDDTL)=X X ^DD("DD") W " ",Y,! S SDDTPL=Y G ASK
I Y<SDDTF W !!,$C(7),"Ending date must be after beginning date!",! G LDT
G:Y<1 LDT S SDDTL=Y X ^DD("DD") S SDDTPL=Y,SDDTL=SDDTL_".999999"
ASK D SUBT^SCRPW50("*** Additional Detail Selection ***")
W ! K DIR S DIR(0)="Y",DIR("A")="Break out workload by clinic group",DIR("B")="NO",DIR("?")="Specify if subtotals by encounter location CLINIC GROUP should be provided." D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT^SCRPW8 S SDCLGR=Y
D DETAIL^SCRPW9 W ! G:SDZ(0)=-1 EXIT^SCRPW8
K DIR S DIR(0)="Y",DIR("A")="List facility 'action required'/not accepted unique patients",DIR("B")="NO" D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT^SCRPW8 S SDUL=Y W !
QUE S ZTRTN="PST^SCRPW8",ZTDESC="Outpatient Encounter Workload" F SDI="SDCLGR","SDDTF","SDDTPF","SDDTL","SDDTPL","SDUL","SDDUL","SDZ(" S ZTSAVE(SDI)=""
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE) G EXIT^SCRPW8
SCRPW9 ;RENO/KEITH - Outpatient Encounter Workload Statistics (cont.) ; 15 Jul 98 02:38PM
+1 ;;5.3;Scheduling;**139,144,339,466,510,1015**;AUG 13, 1993;Build 21
UNARL(SDS1,SDS2) ;Print list of 'action required'/not accepted uniques
+1 ;Required input: SDS1,SDS2=subscript values
+2 SET SDPAGE=1
DO UHDR
IF SDOUT
QUIT
IF '$DATA(^TMP(SDS1,$JOB,SDS2,"VISIT","UNARL"))
WRITE !!,"No 'action required'/not accepted unique patients identified."
QUIT
+3 SET SDARCT=0
SET SDPNAM=""
FOR
SET SDPNAM=$ORDER(^TMP(SDS1,$JOB,SDS2,"VISIT","UNARL",SDPNAM))
IF SDPNAM=""!SDOUT
QUIT
SET DFN=0
FOR
SET DFN=$ORDER(^TMP(SDS1,$JOB,SDS2,"VISIT","UNARL",SDPNAM,DFN))
IF 'DFN!SDOUT
QUIT
DO UNP
+4 IF SDOUT
QUIT
IF $Y>(IOSL-3)
DO UHDR
IF SDOUT
QUIT
WRITE !!,SDARCT," 'action required'/not accepted unique patient",$SELECT(SDARCT=1:"",1:"s")," identified."
QUIT
+5 ;
UNP SET SDSSN=$ORDER(^TMP(SDS1,$JOB,SDS2,"VISIT","UNARL",SDPNAM,DFN,""))
IF $Y>(IOSL-4)
DO UHDR
IF SDOUT
QUIT
WRITE !,$EXTRACT(SDPNAM,1,18),?20,SDSSN
+1 SET SDARCT=SDARCT+1
SET (SDDT,SDI)=0
FOR
SET SDDT=$ORDER(^TMP(SDS1,$JOB,SDS2,"VISIT","UNARL",SDPNAM,DFN,SDSSN,SDDT))
IF 'SDDT!SDOUT
QUIT
IF $Y>(IOSL-4)
DO UHDR
IF SDOUT
QUIT
SET Y=SDDT
XECUTE ^DD("DD")
IF SDI
WRITE !
WRITE ?31,Y
SET SDI=1
DO UNP1
+2 QUIT
+3 ;
UNP1 NEW SDII,SDDT1
SET SDII=0
SET SDDT1=SDDT
FOR
SET SDDT1=$ORDER(^SCE("ADFN",DFN,SDDT1))
IF 'SDDT1!(SDDT1>(SDDT+.9999))!SDOUT
QUIT
Begin DoDot:1
+1 SET SDOE=0
FOR
SET SDOE=$ORDER(^SCE("ADFN",DFN,SDDT1,SDOE))
IF 'SDOE!SDOUT
QUIT
SET SDOE0=$$GETOE^SDOE(SDOE)
IF $LENGTH(SDOE0)
IF '$PIECE(SDOE0,U,6)
DO UNP2
+2 QUIT
End DoDot:1
+3 QUIT
+4 ;
UNP2 NEW SDCL,SDST
IF '$PIECE(SDOE0,U,4)
QUIT
SET SDCL=$PIECE($GET(^SC($PIECE(SDOE0,U,4),0)),U)
SET SDST=$PIECE(SDOE0,U,12)
IF $PIECE($GET(^SC($PIECE(SDOE0,U,4),0)),U,17)="Y"
QUIT
IF 'SDST!(SDST=12)
QUIT
SET SDST=$SELECT("28"'[SDST:$PIECE(^SD(409.63,SDST,0),U),1:$PIECE($$STX^SCRPW8(SDOE,SDOE0),U,3))
+1 IF $Y>(IOSL-4)
DO UHDR
IF SDOUT
QUIT
IF SDII
WRITE !
WRITE ?44,$EXTRACT(SDCL,1,17),?63,$EXTRACT(SDST,1,17)
SET SDII=SDII+1
QUIT
+2 ;
UHDR IF $EXTRACT(IOST)="C"
NEW DIR
SET DIR(0)="E"
DO ^DIR
SET SDOUT=Y'=1
IF SDOUT
QUIT
+1 DO STOP^SCRPW8
IF SDOUT
QUIT
+2 WRITE $$XY^SCRPW50(IOF,1,0),SDLINE,!?8,"<*> LIST OF 'ACTION REQUIRED'/NOT ACCEPTED UNIQUE PATIENTS <*>",!?(66-$LENGTH(SDDNAM)\2),"For station: ",SDDNAM
+3 WRITE !,SDLINE,!,"For encounter dates ",SDDTPF," to ",SDDTPL,!,"Date printed: ",SDPNOW,?(74-$LENGTH(SDPAGE)),"Page: ",SDPAGE,!,SDLINE,!
SET SDPAGE=SDPAGE+1
+4 IF $DATA(^TMP(SDS1,$JOB,SDS2,"VISIT","UNARL"))
WRITE !,"Name:",?20,"SSN:",?31,"Date:",?44,"Location:",?63,"Reason:",!
QUIT
+5 ;
DETAIL ;Ask questions for detail of encounters or uniques for a division
+1 KILL SDZ
SET SDZ(0)=0
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Would you like to print a detailed list of activity for a division"
SET DIR("B")="NO"
WRITE !
DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SDZ(0)=-1
QUIT
+2 SET SDZ(0)=Y
IF 'Y
QUIT
WRITE !!!,$CHAR(7)," WARNING: Selection high activity areas will result in lengthy output!",!
+3 KILL DIR
SET DIR(0)="S^U:UNIQUES;V:VISITS;E:ENCOUNTERS"
SET DIR("A")="Select type of list"
DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SDZ(0)=-1
QUIT
+4 SET SDZ(1)=Y
IF Y'="E"
GOTO ZDIV
DET1 KILL DIC
SET DIC="^SD(409.63,"
SET DIC(0)="AEMQ"
SET DIC("S")="I Y<4!(Y=8!(Y=12!(Y=14)))"
SET DIC("A")="Select encounter status: "
WRITE !
DO ^DIC
IF $DATA(DTOUT)!$DATA(DUOUT)!($GET(Y)<1)
SET SDZ(0)=-1
QUIT
+1 SET SDZ(2)=$PIECE(Y,U)
IF (SDZ(2)'=2)&(SDZ(2)'=8)
GOTO ZDIV
KILL DIR
SET DIR("A")="Select transmission status for "_$SELECT(SDZ(2)=2:"CHECKED OUT",1:"INPATIENT APPOINTMENT")_" encounters"
+2 SET DIR(0)="S^A:All transmission statuses;1:No transmission record;2:Not required, not transmitted;3:Rejected for transmission;4:Awaiting transmission;"
+3 SET DIR(0)=DIR(0)_"5:Transmitted, no acknowledgment;6:Transmitted, rejected;7:Transmitted, error;8:Transmitted, accepted"
+4 IF SDZ(2)=8
SET DIR(0)=DIR(0)_";9:Non-Count (not transmitted)"
+5 ;SD*5.3*339 add sub-zero
WRITE !
DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SDZ(0)=-1
QUIT
+6 SET SDZ(3)=+Y
ZDIV ;Get division for detail
+1 IF '$PIECE($GET(^DG(43,1,"GL")),U,2)
SET SDZ(4)=$PIECE(^DG(40.8,$$PRIM^VASITE(),0),U)
QUIT
+2 KILL DIC
SET DIC="^DG(40.8,"
SET DIC("A")="Select Medical Center division for detail: "
SET DIC(0)="AEMQ"
WRITE !
DO ^DIC
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SDZ(0)=-1
QUIT
+3 IF Y<1
WRITE $CHAR(7)," Required for patient detail!"
GOTO ZDIV
+4 SET SDZ(4)=$PIECE(Y,U,2)
QUIT
+5 ;
DPRT(SDS1,SDS2) ;Detail print
+1 ;Required input: SDS1,SDS2=subscript values
+2 KILL SDH
SET SDPAGE=1
SET SDH(1)="<*> DETAILED LIST OF DIVISION "_$SELECT(SDZ(1)="U":"UNIQUES",SDZ(1)="V":"VISITS",1:"ENCOUNTERS")_" <*>"
SET SDH(2)="For division: "_SDZ(4)
+3 IF $GET(SDZ(2))
SET SDH(3)="Encounters with "_$PIECE(^SD(409.63,SDZ(2),0),U)_" status"
+4 IF $GET(SDZ(2))'=""
IF "28"[SDZ(2)
SET SDH(4)="Transmission status: "_$PIECE($TEXT(TXS+SDZ(3)),";",2)
+5 DO DHDR
IF SDOUT
QUIT
IF '$DATA(^TMP(SDS1,$JOB,SDS2,"DETAIL"))
WRITE !,"No records found in this category."
QUIT
+6 SET SDCT=0
DO @SDZ(1)
QUIT
+7 ;
U ;Print uniques
+1 SET SDPNAM=""
FOR
SET SDPNAM=$ORDER(^TMP(SDS1,$JOB,SDS2,"DETAIL",SDPNAM))
IF SDPNAM=""!SDOUT
QUIT
SET DFN=0
FOR
SET DFN=$ORDER(^TMP(SDS1,$JOB,SDS2,"DETAIL",SDPNAM,DFN))
IF 'DFN!SDOUT
QUIT
DO U1
+2 IF SDOUT
QUIT
WRITE !!,SDCT," uniques identified."
QUIT
+3 ;
U1 SET SDCT=SDCT+1
SET SDSSN=$ORDER(^TMP(SDS1,$JOB,SDS2,"DETAIL",SDPNAM,DFN,""))
IF $Y>(IOSL-4)
DO DHDR
IF SDOUT
QUIT
WRITE !,$EXTRACT(SDPNAM,1,18),?21,SDSSN
QUIT
+1 ;
V ;Print visits
+1 SET SDPNAM=""
FOR
SET SDPNAM=$ORDER(^TMP(SDS1,$JOB,SDS2,"DETAIL",SDPNAM))
IF SDPNAM=""!SDOUT
QUIT
SET DFN=0
FOR
SET DFN=$ORDER(^TMP(SDS1,$JOB,SDS2,"DETAIL",SDPNAM,DFN))
IF 'DFN!SDOUT
QUIT
SET SDSSN=$ORDER(^TMP(SDS1,$JOB,SDS2,"DETAIL",SDPNAM,DFN,""))
DO V1
+2 IF SDOUT
QUIT
WRITE !!,SDCT," visits identified."
QUIT
+3 ;
V1 IF $Y>(IOSL-4)
DO DHDR
IF SDOUT
QUIT
WRITE !,$EXTRACT(SDPNAM,1,18),?21,SDSSN
SET (SDDT,SDI)=0
FOR
SET SDDT=$ORDER(^TMP(SDS1,$JOB,SDS2,"DETAIL",SDPNAM,DFN,SDSSN,SDDT))
IF 'SDDT!SDOUT
QUIT
Begin DoDot:1
+1 IF $Y>(IOSL-3)
DO DHDR
IF SDOUT
QUIT
SET Y=SDDT
XECUTE ^DD("DD")
IF SDI
WRITE !
WRITE ?32,Y
SET SDCT=SDCT+1
SET SDI=SDI+1
+2 QUIT
End DoDot:1
+3 QUIT
+4 ;
E ;Print encounters
+1 SET SDPNAM=""
FOR
SET SDPNAM=$ORDER(^TMP(SDS1,$JOB,SDS2,"DETAIL",SDPNAM))
IF SDPNAM=""!SDOUT
QUIT
SET DFN=0
FOR
SET DFN=$ORDER(^TMP(SDS1,$JOB,SDS2,"DETAIL",SDPNAM,DFN))
IF 'DFN!SDOUT
QUIT
SET SDSSN=$ORDER(^TMP(SDS1,$JOB,SDS2,"DETAIL",SDPNAM,DFN,""))
DO E1
+2 IF SDOUT
QUIT
WRITE !!,SDCT," encounters identified."
QUIT
+3 ;
E1 IF $Y>(IOSL-4)
DO DHDR
IF SDOUT
QUIT
WRITE !,$EXTRACT(SDPNAM,1,18),?21,SDSSN
+1 SET (SDDT,SDI)=0
FOR
SET SDDT=$ORDER(^TMP(SDS1,$JOB,SDS2,"DETAIL",SDPNAM,DFN,SDSSN,SDDT))
IF 'SDDT!SDOUT
QUIT
SET SDOE=0
FOR
SET SDOE=$ORDER(^TMP(SDS1,$JOB,SDS2,"DETAIL",SDPNAM,DFN,SDSSN,SDDT,SDOE))
IF 'SDOE!SDOUT
QUIT
DO E2
+2 QUIT
+3 ;
E2 IF $Y>(IOSL-3)
DO DHDR
IF SDOUT
QUIT
SET SDHL=^TMP(SDS1,$JOB,SDS2,"DETAIL",SDPNAM,DFN,SDSSN,SDDT,SDOE)
SET SDHL=$PIECE($GET(^SC(+SDHL,0)),U)
SET Y=SDDT
XECUTE ^DD("DD")
IF SDI
WRITE !
WRITE ?32,$PIECE(Y,":",1,2),?50,SDHL
SET SDCT=SDCT+1
SET SDI=SDI+1
QUIT
+1 ;
DHDR IF $EXTRACT(IOST)="C"
NEW DIR
SET DIR(0)="E"
DO ^DIR
SET SDOUT=Y'=1
IF SDOUT
QUIT
+1 DO STOP^SCRPW8
IF SDOUT
QUIT
+2 WRITE $$XY^SCRPW50(IOF,1,0),SDLINE
SET I=0
FOR
SET I=$ORDER(SDH(I))
IF 'I
QUIT
WRITE !?(80-$LENGTH(SDH(I))\2),SDH(I)
+3 WRITE !,SDLINE,!,"For date range: ",SDDTPF," to ",SDDTPL,!,"Date printed: ",SDPNOW,?(74-$LENGTH(SDPAGE)),"Page: ",SDPAGE,!,SDLINE,!
SET SDPAGE=SDPAGE+1
QUIT
+4 ;
TXS ;All transmission statuses
+1 ;No transmission record
+2 ;Not required, not transmitted
+3 ;Rejected for transmission
+4 ;Awaiting transmission
+5 ;Transmitted, no acknowledgment
+6 ;Transmitted, rejected
+7 ;Transmitted, error
+8 ;Transmitted, accepted
+9 ;Non-Count (not transmitted)
+10 ;
PARM ;Prompt for report parameters
+1 DO TITL^SCRPW50("Outpatient Encounter Workload Statistics")
+2 NEW %DT,DIR,DIC
DO SUBT^SCRPW50("*** Date Range Selection ***")
FDT WRITE !
SET %DT="AEPX"
SET %DT("A")="Beginning date: FIRST// "
SET %DT(0)=2961001
DO ^%DT
IF X=U!$DATA(DTOUT)
GOTO EXIT^SCRPW8
IF X=""
SET (Y,SDDTF)=2961001
XECUTE ^DD("DD")
WRITE " ",Y,!
SET SDDTPF=Y
GOTO LDT
+1 IF Y<1
GOTO FDT
SET SDDTF=Y
XECUTE ^DD("DD")
SET SDDTPF=Y
WRITE !
LDT SET %DT("A")="Ending date: LAST// "
DO ^%DT
IF X=U!$DATA(DTOUT)
GOTO EXIT^SCRPW8
IF X=""
SET X1=DT
SET X2=-1
DO C^%DTC
SET (Y,SDDTL)=X
XECUTE ^DD("DD")
WRITE " ",Y,!
SET SDDTPL=Y
GOTO ASK
+1 IF Y<SDDTF
WRITE !!,$CHAR(7),"Ending date must be after beginning date!",!
GOTO LDT
+2 IF Y<1
GOTO LDT
SET SDDTL=Y
XECUTE ^DD("DD")
SET SDDTPL=Y
SET SDDTL=SDDTL_".999999"
ASK DO SUBT^SCRPW50("*** Additional Detail Selection ***")
+1 WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Break out workload by clinic group"
SET DIR("B")="NO"
SET DIR("?")="Specify if subtotals by encounter location CLINIC GROUP should be provided."
DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT^SCRPW8
SET SDCLGR=Y
+2 DO DETAIL^SCRPW9
WRITE !
IF SDZ(0)=-1
GOTO EXIT^SCRPW8
+3 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="List facility 'action required'/not accepted unique patients"
SET DIR("B")="NO"
DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT^SCRPW8
SET SDUL=Y
WRITE !
QUE SET ZTRTN="PST^SCRPW8"
SET ZTDESC="Outpatient Encounter Workload"
FOR SDI="SDCLGR","SDDTF","SDDTPF","SDDTL","SDDTPL","SDUL","SDDUL","SDZ("
SET ZTSAVE(SDI)=""
+1 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE)
GOTO EXIT^SCRPW8
