SCRPW60 ;BP-CIOFO/KEITH - Patient Appointment Statistics ; 19 Nov 98 10:34 AM
;;5.3;Scheduling;**163**;AUG 13, 1993
;Prompt for report parameters
D TITL^SCRPW50("Patient Appointment Statistics")
N SDDIV G:'$$DIVA^SCRPW17(.SDDIV) EXIT
DTR ;Date range selection
D SUBT^SCRPW50("*** Date Range Selection ***")
FDT W ! S %DT="AEX",%DT("A")="Beginning date: " D ^%DT G:X=U!($D(DTOUT)) EXIT G:X="" EXIT
G:Y<1 FDT S SDBDAY=Y X ^DD("DD") S SDPBDA=Y
LDT W ! S %DT("A")=" Ending date: " D ^%DT G:X=U!($D(DTOUT)) EXIT G:X="" EXIT
I Y<SDBDAY W !!,$C(7),"Ending date must be after beginning date!" G LDT
G:Y<1 LDT S SDEDAY=Y_.9999 X ^DD("DD") S SDPEDA=Y
TYP ;Report format selection
D SUBT^SCRPW50("*** Report Format Selection ***")
S SDQUIT=0,DIR(0)="S^AC:ALL CLINICS;SC:SELECTED CLINICS;RC:RANGE OF CLINICS;SS:SELECTED STOP CODES;RS:RANGE OF STOP CODES;CG:CLINIC GROUP"
W ! D ^DIR G:($D(DTOUT)!$D(DUOUT)) EXIT S SDF=Y I Y="SC" D SEL G:(SDQUIT!'$D(SDCL)) EXIT
I SDF="RC" D SRC S SDCL="",SDCL=$O(SDCL(SDCL)) G:SDCL="" EXIT S SDCL=$O(SDCL(SDCL)) G:SDCL="" EXIT
I SDF="SS" D SSS G:'$O(SDCL(0)) EXIT
I SDF="RS" D SRS G:'$O(SDCL(0)) EXIT
I SDF="CG" D SCG G:'$O(SDCL(0)) EXIT
K DIR S DIR(0)="Y",DIR("A")="Include list of patient names",DIR("B")="NO",DIR("?")="Specify if you would like to see a list of patient names for each clinic."
S SDOUT=0 W ! D ^DIR G:$D(DUOUT)!$D(DTOUT) EXIT S SDPL=Y I Y D G:SDOUT EXIT
.K DIR S DIR(0)="S^A:ALPHABETIC;D:DATE/TIME;T:TERMINAL DIGIT",DIR("A")="Within clinic, print patients in what order",DIR("B")="ALPHABETIC"
.D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 Q
.S SDPLO=Y Q
;
QUE N Z,ZTSAVE F Z="SDPL","SDPLO","SDDIV","SDDIV(","SDBDAY","SDEDAY","SDPBDA","SDPEDA","SDF","SDCL(" S ZTSAVE(Z)=""
W ! D EN^XUTMDEVQ("START^SCRPW60","Patient Appointment Statistics",.ZTSAVE)
G EXIT
;
START ;Initialize variables, gather information
K ^TMP("SCRPW",$J) S SDCOL=$S(IOM=80:0,1:26),SDOUT=0,SDMD="",SDMD=$O(SDDIV(SDMD)),SDMD=$O(SDDIV(SDMD)) S:$P(SDDIV,U,2)="ALL DIVISIONS" SDMD=1
D @(SDF_"^SCRPW61") G:SDOUT EXIT D CNT^SCRPW61 G:SDOUT EXIT
S SDPAGE=1,SDLINE="",$P(SDLINE,"-",(IOM+1))="",SDTLINE=$TR(SDLINE,"-","=") D NOW^%DTC S Y=% X ^DD("DD") S SDPNOW=$P(Y,":",1,2),SDT(1)="<*> PATIENT APPOINTMENT STATISTICS <*>"
S SDT(2)=$S(SDF="AC":"FOR ALL ACTIVE CLINICS",SDF="SC":"FOR SELECTED CLINICS",SDF="RC":"FOR RANGE OF ACTIVE CLINICS",SDF="SS":"FOR SELECTED STOP CODES",SDF="RS":"FOR RANGE OF STOP CODES",SDF="CG":"FOR CLINIC GROUP")
I SDF="RC" S SDCLN=$O(SDCL("")),SDECL=$O(SDCL(SDCLN)),SDT(3)=SDCLN_" TO "_SDECL
I SDF="RS" S SDBCS=$O(SDCL(0)),SDECS=$O(SDCL(SDBCS)) S:SDECS="" SDECS=SDBCS S SDT(2)=SDT(2)_": "_SDBCS_" TO "_SDECS
I SDF="CG" S SDI=$O(SDCL(0)),SDT(2)=SDT(2)_": "_SDCL(SDI)
;Print report
D:$E(IOST)="C" DISP0^SCRPW23 I '$D(^TMP("SCRPW",$J)) S SDIV=0 D DHDR^SCRPW40(4,.SDT),HDR S SDX="No appointments found for the specified date range." W !!?(IOM-$L(SDX)\2),SDX D FOOT^SCRPW61 G EXIT
S SDIV="" F S SDIV=$O(SDDIV(SDIV)) Q:'SDIV S SDIV(SDDIV(SDIV))=SDIV
I 'SDDIV,$P(SDDIV,U,2)'="ALL DIVISIONS" S SDIV($P(SDDIV,U,2))=$$PRIM^VASITE()
I $P(SDDIV,U,2)="ALL DIVISIONS" S SDI=0 F S SDI=$O(^TMP("SCRPW",$J,SDI)) Q:'SDI S SDX=$P($G(^DG(40.8,SDI,0)),U) S:$L(SDX) SDIV(SDX)=SDI
S SDIVN="" F S SDIVN=$O(SDIV(SDIVN)) Q:SDIVN=""!SDOUT S SDIV=SDIV(SDIVN) D DPRT^SCRPW61(.SDIV)
S SDI=0,SDI=$O(^TMP("SCRPW",$J,SDI)),SDMD=$O(^TMP("SCRPW",$J,SDI))
G:SDOUT EXIT I SDMD S SDIV=0 D DPRT^SCRPW61(.SDIV)
I $E(IOST)="C",'SDOUT N DIR S DIR(0)="E" D ^DIR
;
EXIT K %,%DT,DFN,DIC,DIR,DTOUT,DUOUT,SDAC,SDAPP,SDBCS,SDBDAY,SDCG,SDCL,SDCL0,SDCLN,SDCOL,SDCP0,SDCSC,SDCTOT,SDDAY,SDDIV,SDECL,SDECS,SDEDAY,SDF
K SDH,SDI,SDIV,SDIVN,SDLINE,SDMD,SDORD,SDOUT,SDPAGE,SDPBDA,SDPEDA,SDPL,SDPLO,SDPNOW,SDTLINE,SDPTNA,SDQUIT,SDSSN,SDT,SDTOT,SDX,X,Y,Z
D END^SCRPW50 Q
;
SEL ;Pick selected clinics
W ! F D ASK Q:(SDQUIT!(X=""))
Q
ASK K DIC S DIC(0)="AEMQ",DIC="^SC(",DIC("S")="I $P(^(0),U,3)=""C""" S:SDDIV DIC("S")=DIC("S")_",$D(SDDIV(+$P(^(0),U,15)))" D ^DIC
I ($D(DTOUT)!$D(DUOUT)) S SDQUIT=1
S:Y>0 SDCL(+Y)="" Q
;
SRC ;Select clinic range
W ! K DIC S DIC="^SC(",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,3)=""C"""_$S(SDDIV:",$D(SDDIV(+$P(^(0),U,15)))",1:""),DIC("A")="Select BEGINNING Clinic: " D ^DIC Q:($D(DTOUT)!$D(DUOUT)!(X="")) S SDCL($P(Y,U,2))=$P(Y,U)
C2 W ! S DIC("A")="Select ENDING Clinic: " D ^DIC Q:($D(DTOUT)!$D(DUOUT)!(X="")) I $P(Y,U,2)]$O(SDCL("")) S SDCL($P(Y,U,2))=$P(Y,U) Q
W !!,$C(7),"Ending clinic must collate after beginning clinic!" G C2
;
SSS ;Pick selected Stop Codes
W ! K DIC S DIC="^DIC(40.7,",DIC(0)="AEMQZ",DIC("A")="Select Stop Code: "
F D ^DIC Q:$D(DTOUT)!$D(DUOUT) Q:Y<1 S SDCL($P(Y(0),U,2))=""
Q
;
SRS ;Select Stop Code range
W ! K DIC S DIC="^DIC(40.7,",DIC(0)="AEMZQ",DIC("A")="Select BEGINNING Stop Code: " D ^DIC Q:($D(DTOUT)!$D(DUOUT)) G:Y<1 SRS S SDCL=$P(Y(0),U,2),SDCL(SDCL)=""
SRSE S DIC("A")="Select ENDING Stop Code: "
W ! D ^DIC I ($D(DTOUT)!$D(DUOUT)) K SDCL Q
G:Y<1 SRSE
I SDCL]$P(Y(0),U,2) W !!,$C(7),"Ending Stop Code must collate after beginning Stop Code!" G SRSE
S SDCL($P(Y(0),U,2))="" Q
;
SCG ;Select clinic group
W ! K DIC S DIC="^SD(409.67,",DIC(0)="AEMQ" D ^DIC Q:$D(DTOUT)!$D(DUOUT) Q:Y<1 S SDCL(+Y)=$P(Y,U,2) Q
;
HDR ;Print report header
I $E(IOST)="C",SDPAGE>1 N DIR S DIR(0)="E" D ^DIR S SDOUT=Y'=1 Q:SDOUT
D STOP^SCRPW61 Q:SDOUT
W:SDPAGE>1!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0) W:$X $$XY^SCRPW50("",0,0) W SDLINE S X=0 F S X=$O(SDT(X)) Q:'X W !?(IOM-$L(SDT(X))\2),SDT(X)
W !,SDLINE,!,"For date range: ",SDPBDA," to ",SDPEDA,!,"Date printed: ",SDPNOW,?((IOM-6)-$L(SDPAGE)),"Page: ",SDPAGE
W !,SDLINE S X=0 F S X=$O(SDH(X)) Q:'X X SDH(X)
W !,SDLINE S SDPAGE=SDPAGE+1 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPW60 5771 printed Oct 16, 2024@18:44:33 Page 2
SCRPW60 ;BP-CIOFO/KEITH - Patient Appointment Statistics ; 19 Nov 98 10:34 AM
+1 ;;5.3;Scheduling;**163**;AUG 13, 1993
+2 ;Prompt for report parameters
+3 DO TITL^SCRPW50("Patient Appointment Statistics")
+4 NEW SDDIV
if '$$DIVA^SCRPW17(.SDDIV)
GOTO EXIT
DTR ;Date range selection
+1 DO SUBT^SCRPW50("*** Date Range Selection ***")
FDT WRITE !
SET %DT="AEX"
SET %DT("A")="Beginning date: "
DO ^%DT
if X=U!($DATA(DTOUT))
GOTO EXIT
if X=""
GOTO EXIT
+1 if Y<1
GOTO FDT
SET SDBDAY=Y
XECUTE ^DD("DD")
SET SDPBDA=Y
LDT WRITE !
SET %DT("A")=" Ending date: "
DO ^%DT
if X=U!($DATA(DTOUT))
GOTO EXIT
if X=""
GOTO EXIT
+1 IF Y<SDBDAY
WRITE !!,$CHAR(7),"Ending date must be after beginning date!"
GOTO LDT
+2 if Y<1
GOTO LDT
SET SDEDAY=Y_.9999
XECUTE ^DD("DD")
SET SDPEDA=Y
TYP ;Report format selection
+1 DO SUBT^SCRPW50("*** Report Format Selection ***")
+2 SET SDQUIT=0
SET DIR(0)="S^AC:ALL CLINICS;SC:SELECTED CLINICS;RC:RANGE OF CLINICS;SS:SELECTED STOP CODES;RS:RANGE OF STOP CODES;CG:CLINIC GROUP"
+3 WRITE !
DO ^DIR
if ($DATA(DTOUT)!$DATA(DUOUT))
GOTO EXIT
SET SDF=Y
IF Y="SC"
DO SEL
if (SDQUIT!'$DATA(SDCL))
GOTO EXIT
+4 IF SDF="RC"
DO SRC
SET SDCL=""
SET SDCL=$ORDER(SDCL(SDCL))
if SDCL=""
GOTO EXIT
SET SDCL=$ORDER(SDCL(SDCL))
if SDCL=""
GOTO EXIT
+5 IF SDF="SS"
DO SSS
if '$ORDER(SDCL(0))
GOTO EXIT
+6 IF SDF="RS"
DO SRS
if '$ORDER(SDCL(0))
GOTO EXIT
+7 IF SDF="CG"
DO SCG
if '$ORDER(SDCL(0))
GOTO EXIT
+8 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Include list of patient names"
SET DIR("B")="NO"
SET DIR("?")="Specify if you would like to see a list of patient names for each clinic."
+9 SET SDOUT=0
WRITE !
DO ^DIR
if $DATA(DUOUT)!$DATA(DTOUT)
GOTO EXIT
SET SDPL=Y
IF Y
Begin DoDot:1
+10 KILL DIR
SET DIR(0)="S^A:ALPHABETIC;D:DATE/TIME;T:TERMINAL DIGIT"
SET DIR("A")="Within clinic, print patients in what order"
SET DIR("B")="ALPHABETIC"
+11 DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SDOUT=1
QUIT
+12 SET SDPLO=Y
QUIT
End DoDot:1
if SDOUT
GOTO EXIT
+13 ;
QUE NEW Z,ZTSAVE
FOR Z="SDPL","SDPLO","SDDIV","SDDIV(","SDBDAY","SDEDAY","SDPBDA","SDPEDA","SDF","SDCL("
SET ZTSAVE(Z)=""
+1 WRITE !
DO EN^XUTMDEVQ("START^SCRPW60","Patient Appointment Statistics",.ZTSAVE)
+2 GOTO EXIT
+3 ;
START ;Initialize variables, gather information
+1 KILL ^TMP("SCRPW",$JOB)
SET SDCOL=$SELECT(IOM=80:0,1:26)
SET SDOUT=0
SET SDMD=""
SET SDMD=$ORDER(SDDIV(SDMD))
SET SDMD=$ORDER(SDDIV(SDMD))
if $PIECE(SDDIV,U,2)="ALL DIVISIONS"
SET SDMD=1
+2 DO @(SDF_"^SCRPW61")
if SDOUT
GOTO EXIT
DO CNT^SCRPW61
if SDOUT
GOTO EXIT
+3 SET SDPAGE=1
SET SDLINE=""
SET $PIECE(SDLINE,"-",(IOM+1))=""
SET SDTLINE=$TRANSLATE(SDLINE,"-","=")
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET SDPNOW=$PIECE(Y,":",1,2)
SET SDT(1)="<*> PATIENT APPOINTMENT STATISTICS <*>"
+4 SET SDT(2)=$SELECT(SDF="AC":"FOR ALL ACTIVE CLINICS",SDF="SC":"FOR SELECTED CLINICS",SDF="RC":"FOR RANGE OF ACTIVE CLINICS",SDF="SS":"FOR SELECTED STOP CODES",SDF="RS":"FOR RANGE OF STOP CODES",SDF="CG":"FOR CLINIC GROUP")
+5 IF SDF="RC"
SET SDCLN=$ORDER(SDCL(""))
SET SDECL=$ORDER(SDCL(SDCLN))
SET SDT(3)=SDCLN_" TO "_SDECL
+6 IF SDF="RS"
SET SDBCS=$ORDER(SDCL(0))
SET SDECS=$ORDER(SDCL(SDBCS))
if SDECS=""
SET SDECS=SDBCS
SET SDT(2)=SDT(2)_": "_SDBCS_" TO "_SDECS
+7 IF SDF="CG"
SET SDI=$ORDER(SDCL(0))
SET SDT(2)=SDT(2)_": "_SDCL(SDI)
+8 ;Print report
+9 if $EXTRACT(IOST)="C"
DO DISP0^SCRPW23
IF '$DATA(^TMP("SCRPW",$JOB))
SET SDIV=0
DO DHDR^SCRPW40(4,.SDT)
DO HDR
SET SDX="No appointments found for the specified date range."
WRITE !!?(IOM-$LENGTH(SDX)\2),SDX
DO FOOT^SCRPW61
GOTO EXIT
+10 SET SDIV=""
FOR
SET SDIV=$ORDER(SDDIV(SDIV))
if 'SDIV
QUIT
SET SDIV(SDDIV(SDIV))=SDIV
+11 IF 'SDDIV
IF $PIECE(SDDIV,U,2)'="ALL DIVISIONS"
SET SDIV($PIECE(SDDIV,U,2))=$$PRIM^VASITE()
+12 IF $PIECE(SDDIV,U,2)="ALL DIVISIONS"
SET SDI=0
FOR
SET SDI=$ORDER(^TMP("SCRPW",$JOB,SDI))
if 'SDI
QUIT
SET SDX=$PIECE($GET(^DG(40.8,SDI,0)),U)
if $LENGTH(SDX)
SET SDIV(SDX)=SDI
+13 SET SDIVN=""
FOR
SET SDIVN=$ORDER(SDIV(SDIVN))
if SDIVN=""!SDOUT
QUIT
SET SDIV=SDIV(SDIVN)
DO DPRT^SCRPW61(.SDIV)
+14 SET SDI=0
SET SDI=$ORDER(^TMP("SCRPW",$JOB,SDI))
SET SDMD=$ORDER(^TMP("SCRPW",$JOB,SDI))
+15 if SDOUT
GOTO EXIT
IF SDMD
SET SDIV=0
DO DPRT^SCRPW61(.SDIV)
+16 IF $EXTRACT(IOST)="C"
IF 'SDOUT
NEW DIR
SET DIR(0)="E"
DO ^DIR
+17 ;
EXIT KILL %,%DT,DFN,DIC,DIR,DTOUT,DUOUT,SDAC,SDAPP,SDBCS,SDBDAY,SDCG,SDCL,SDCL0,SDCLN,SDCOL,SDCP0,SDCSC,SDCTOT,SDDAY,SDDIV,SDECL,SDECS,SDEDAY,SDF
+1 KILL SDH,SDI,SDIV,SDIVN,SDLINE,SDMD,SDORD,SDOUT,SDPAGE,SDPBDA,SDPEDA,SDPL,SDPLO,SDPNOW,SDTLINE,SDPTNA,SDQUIT,SDSSN,SDT,SDTOT,SDX,X,Y,Z
+2 DO END^SCRPW50
QUIT
+3 ;
SEL ;Pick selected clinics
+1 WRITE !
FOR
DO ASK
if (SDQUIT!(X=""))
QUIT
+2 QUIT
ASK KILL DIC
SET DIC(0)="AEMQ"
SET DIC="^SC("
SET DIC("S")="I $P(^(0),U,3)=""C"""
if SDDIV
SET DIC("S")=DIC("S")_",$D(SDDIV(+$P(^(0),U,15)))"
DO ^DIC
+1 IF ($DATA(DTOUT)!$DATA(DUOUT))
SET SDQUIT=1
+2 if Y>0
SET SDCL(+Y)=""
QUIT
+3 ;
SRC ;Select clinic range
+1 WRITE !
KILL DIC
SET DIC="^SC("
SET DIC(0)="AEMQ"
SET DIC("S")="I $P(^(0),U,3)=""C"""_$SELECT(SDDIV:",$D(SDDIV(+$P(^(0),U,15)))",1:"")
SET DIC("A")="Select BEGINNING Clinic: "
DO ^DIC
if ($DATA(DTOUT)!$DATA(DUOUT)!(X=""))
QUIT
SET SDCL($PIECE(Y,U,2))=$PIECE(Y,U)
C2 WRITE !
SET DIC("A")="Select ENDING Clinic: "
DO ^DIC
if ($DATA(DTOUT)!$DATA(DUOUT)!(X=""))
QUIT
IF $PIECE(Y,U,2)]$ORDER(SDCL(""))
SET SDCL($PIECE(Y,U,2))=$PIECE(Y,U)
QUIT
+1 WRITE !!,$CHAR(7),"Ending clinic must collate after beginning clinic!"
GOTO C2
+2 ;
SSS ;Pick selected Stop Codes
+1 WRITE !
KILL DIC
SET DIC="^DIC(40.7,"
SET DIC(0)="AEMQZ"
SET DIC("A")="Select Stop Code: "
+2 FOR
DO ^DIC
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
if Y<1
QUIT
SET SDCL($PIECE(Y(0),U,2))=""
+3 QUIT
+4 ;
SRS ;Select Stop Code range
+1 WRITE !
KILL DIC
SET DIC="^DIC(40.7,"
SET DIC(0)="AEMZQ"
SET DIC("A")="Select BEGINNING Stop Code: "
DO ^DIC
if ($DATA(DTOUT)!$DATA(DUOUT))
QUIT
if Y<1
GOTO SRS
SET SDCL=$PIECE(Y(0),U,2)
SET SDCL(SDCL)=""
SRSE SET DIC("A")="Select ENDING Stop Code: "
+1 WRITE !
DO ^DIC
IF ($DATA(DTOUT)!$DATA(DUOUT))
KILL SDCL
QUIT
+2 if Y<1
GOTO SRSE
+3 IF SDCL]$PIECE(Y(0),U,2)
WRITE !!,$CHAR(7),"Ending Stop Code must collate after beginning Stop Code!"
GOTO SRSE
+4 SET SDCL($PIECE(Y(0),U,2))=""
QUIT
+5 ;
SCG ;Select clinic group
+1 WRITE !
KILL DIC
SET DIC="^SD(409.67,"
SET DIC(0)="AEMQ"
DO ^DIC
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
if Y<1
QUIT
SET SDCL(+Y)=$PIECE(Y,U,2)
QUIT
+2 ;
HDR ;Print report header
+1 IF $EXTRACT(IOST)="C"
IF SDPAGE>1
NEW DIR
SET DIR(0)="E"
DO ^DIR
SET SDOUT=Y'=1
if SDOUT
QUIT
+2 DO STOP^SCRPW61
if SDOUT
QUIT
+3 if SDPAGE>1!($EXTRACT(IOST)="C")
WRITE $$XY^SCRPW50(IOF,1,0)
if $X
WRITE $$XY^SCRPW50("",0,0)
WRITE SDLINE
SET X=0
FOR
SET X=$ORDER(SDT(X))
if 'X
QUIT
WRITE !?(IOM-$LENGTH(SDT(X))\2),SDT(X)
+4 WRITE !,SDLINE,!,"For date range: ",SDPBDA," to ",SDPEDA,!,"Date printed: ",SDPNOW,?((IOM-6)-$LENGTH(SDPAGE)),"Page: ",SDPAGE
+5 WRITE !,SDLINE
SET X=0
FOR
SET X=$ORDER(SDH(X))
if 'X
QUIT
XECUTE SDH(X)
+6 WRITE !,SDLINE
SET SDPAGE=SDPAGE+1
QUIT
