DGPREP3 ;ALB/SCK - Pre-Registration calling statistics ; 1/2/97
;;5.3;Registration;**109**;Aug 13, 1993
Q
;
EN ; Main entry point for pre-registration calling statistics
N X1,DIR,DGPBEG,DGPEND,DGPDSH,DGPN1,DGPDATA,VAUTD,DGPN2,DGPTOT,DGPE,DGPABRT,DGSNGLDV
;
K DUOUT,DIRUT,^TMP("DGPRERPT",$J)
S DIR(0)="DA^::EX"
S X1=$P($$NOW^XLFDT,".")
S DIR("?",1)="Enter the beginning or ending date in an acceptable format"
S DIR("?")="The ending date cannot be before the beginning date."
S DIR("B")=$$FMTE^XLFDT(X1,1)
S DIR("A")="Enter beginning date for report: "
D ^DIR
I $D(DIRUT) G EXIT
S DGPBEG=Y
AGN S DIR("A")="Enter ending date for report: "
D ^DIR
I $D(DIRUT) G EXIT
S DGPEND=Y
I DGPEND<DGPBEG D G AGN
. W !,"The ending date for this report cannot be earlier then the beginning date"
K DIR
;
; *** Select division
I $P($G(^DG(43,1,"GL")),U,2) D
. D DIVISION^VAUTOMA
E D
. S DGSNGLDV=1
. S VAUTD=1
;
S %ZIS="Q" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. S ZTRTN="RPT^DGPREP3",ZTDESC="DISPLAY PRE-REG CALLING STATS"
. N ZTX
. F ZTX="DGPBEG","DGPEND","VAUTD(","VAUTD","DGSNGLDV" S ZTSAVE(ZTX)=""
. D ^%ZTLOAD W:$D(ZTSK) !,"TASK #: ",ZTSK
. D HOME^%ZIS
. K IO("Q"),ZTSK,ZTDESC,ZTRTN,ZTSAVE
;
D WAIT^DICD
RPT ; Build report data array
U IO
K ^TMP($J)
S $P(DGPDSH,"=",70)=""
S DGPTOT=0
;
S DGPE=DGPEND+.9999
S DGPN1=DGPBEG-.1 F S DGPN1=$O(^DGS(41.43,"B",DGPN1)) Q:'DGPN1!(DGPN1>DGPE) D
. S DGPN2=0 F S DGPN2=$O(^DGS(41.43,"B",DGPN1,DGPN2)) Q:'DGPN2 D
.. S DGPDATA=$G(^DGS(41.43,DGPN2,0))
.. I +$P(DGPDATA,U,5)'>0 D
... I $G(DGSNGLDV) S $P(DGPDATA,U,5)=$S($D(^DG(40.8,1)):1,1:0) Q
... S $P(DGPDATA,U,5)="NO DIV"
.. I VAUTD=1!($D(VAUTD($P(DGPDATA,U,5)))) D
... S DGPTOT=DGPTOT+1
... I $P(DGPDATA,U,4)']"" S ^TMP("DGPRERPT",$J,$P(DGPDATA,U,5),"NONE")=$G(^TMP("DGPRERPT",$J,$P(DGPDATA,U,5),"NONE"))+1 Q
... S ^TMP("DGPRERPT",$J,$P(DGPDATA,U,5),$P(DGPDATA,U,4))=$G(^TMP("DGPRERPT",$J,$P(DGPDATA,U,5),$P(DGPDATA,U,4)))+1
;
D PRNT
;
EXIT ;
D:'$D(ZTQUEUED) ^%ZISC
K ^TMP("DGPERPT",$J),POP,ZTQUEUED
Q
;
PRNT ; Print report to selected device
N DGPDV,SBTOT,SB1,PAGE
;
S PAGE=0
I '$D(^TMP("DGPRERPT",$J)) D G EXIT
. S DGPDV=""
. D HDR
. W !!?10,"No data available"
;
S DGPDV="" F S DGPDV=$O(^TMP("DGPRERPT",$J,DGPDV)) Q:DGPDV']"" D G:$G(DGPABRT) EXIT
. D HDR Q:$G(DGPABRT)
. S SBTOT=0
. W !?10," BUSY: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"B")),5)
. W !?10," CONNECTED: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"C")),5)
. W !?10," DEATH: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"D")),5)
. W !?10," DON'T CALL: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"T")),5)
. W !?10," NO ANSWER: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"N")),5)
. W !?10," NO PHONE: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"P")),5)
. W !?10," UNCOOPERATIVE: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"U")),5)
. W !?10," WRONG NUMBER: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"W")),5)
. W !?10,"LEFT A CALLBACK MSG: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"M")),5)
. W !?10," CHANGE INFORMATION: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"X")),5)
. W !?10," PREVIOUSLY UPDATED: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"V")),5)
. W !?10," CALL BACK: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"K")),5)
. W !?10," NO STATUS: ",$J(+$G(^TMP("DGPRERPT",$J,DGPDV,"NONE")),5)
. W !?10," -------"
. S SB1="" F S SB1=$O(^TMP("DGPRERPT",$J,DGPDV,SB1)) Q:SB1']"" D
.. S SBTOT=$G(SBTOT)++$G(^TMP("DGPRERPT",$J,DGPDV,SB1))
. W !?10," Total for Division: ",$J(SBTOT,5)
Q
;
HDR ;
I PAGE>0,IOST?1"C-".E S DIR(0)="E" D ^DIR S DGPABRT='+$G(Y)
G:$G(DGPABRT) HDRQ
W @IOF
S PAGE=PAGE+1
W !!?5,"PRE-REGISTRATION CALL STATISTICS"
W:DGPDV]"" !?5,"FOR",$S($G(DGSNGLDV):": ",1:" DIVISION: ")
W $S(DGPDV="NO DIV":"NO DIVISION SPECIFIED",+DGPDV>0:$P($G(^DG(40.8,DGPDV,0)),U),1:"")
;
W !?5,"FOR PERIOD COVERING "_$$FMTE^XLFDT(DGPBEG,"2D")_" TO "_$$FMTE^XLFDT(DGPEND,"2D")
W !!?5,DGPDSH
HDRQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPREP3 4076 printed Jan 18, 2025@03:51:46 Page 2
DGPREP3 ;ALB/SCK - Pre-Registration calling statistics ; 1/2/97
+1 ;;5.3;Registration;**109**;Aug 13, 1993
+2 QUIT
+3 ;
EN ; Main entry point for pre-registration calling statistics
+1 NEW X1,DIR,DGPBEG,DGPEND,DGPDSH,DGPN1,DGPDATA,VAUTD,DGPN2,DGPTOT,DGPE,DGPABRT,DGSNGLDV
+2 ;
+3 KILL DUOUT,DIRUT,^TMP("DGPRERPT",$JOB)
+4 SET DIR(0)="DA^::EX"
+5 SET X1=$PIECE($$NOW^XLFDT,".")
+6 SET DIR("?",1)="Enter the beginning or ending date in an acceptable format"
+7 SET DIR("?")="The ending date cannot be before the beginning date."
+8 SET DIR("B")=$$FMTE^XLFDT(X1,1)
+9 SET DIR("A")="Enter beginning date for report: "
+10 DO ^DIR
+11 IF $DATA(DIRUT)
GOTO EXIT
+12 SET DGPBEG=Y
AGN SET DIR("A")="Enter ending date for report: "
+1 DO ^DIR
+2 IF $DATA(DIRUT)
GOTO EXIT
+3 SET DGPEND=Y
+4 IF DGPEND<DGPBEG
Begin DoDot:1
+5 WRITE !,"The ending date for this report cannot be earlier then the beginning date"
End DoDot:1
GOTO AGN
+6 KILL DIR
+7 ;
+8 ; *** Select division
+9 IF $PIECE($GET(^DG(43,1,"GL")),U,2)
Begin DoDot:1
+10 DO DIVISION^VAUTOMA
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 SET DGSNGLDV=1
+13 SET VAUTD=1
End DoDot:1
+14 ;
+15 SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO EXIT
+16 IF $DATA(IO("Q"))
Begin DoDot:1
+17 SET ZTRTN="RPT^DGPREP3"
SET ZTDESC="DISPLAY PRE-REG CALLING STATS"
+18 NEW ZTX
+19 FOR ZTX="DGPBEG","DGPEND","VAUTD(","VAUTD","DGSNGLDV"
SET ZTSAVE(ZTX)=""
+20 DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"TASK #: ",ZTSK
+21 DO HOME^%ZIS
+22 KILL IO("Q"),ZTSK,ZTDESC,ZTRTN,ZTSAVE
End DoDot:1
GOTO EXIT
+23 ;
+24 DO WAIT^DICD
RPT ; Build report data array
+1 USE IO
+2 KILL ^TMP($JOB)
+3 SET $PIECE(DGPDSH,"=",70)=""
+4 SET DGPTOT=0
+5 ;
+6 SET DGPE=DGPEND+.9999
+7 SET DGPN1=DGPBEG-.1
FOR
SET DGPN1=$ORDER(^DGS(41.43,"B",DGPN1))
if 'DGPN1!(DGPN1>DGPE)
QUIT
Begin DoDot:1
+8 SET DGPN2=0
FOR
SET DGPN2=$ORDER(^DGS(41.43,"B",DGPN1,DGPN2))
if 'DGPN2
QUIT
Begin DoDot:2
+9 SET DGPDATA=$GET(^DGS(41.43,DGPN2,0))
+10 IF +$PIECE(DGPDATA,U,5)'>0
Begin DoDot:3
+11 IF $GET(DGSNGLDV)
SET $PIECE(DGPDATA,U,5)=$SELECT($DATA(^DG(40.8,1)):1,1:0)
QUIT
+12 SET $PIECE(DGPDATA,U,5)="NO DIV"
End DoDot:3
+13 IF VAUTD=1!($DATA(VAUTD($PIECE(DGPDATA,U,5))))
Begin DoDot:3
+14 SET DGPTOT=DGPTOT+1
+15 IF $PIECE(DGPDATA,U,4)']""
SET ^TMP("DGPRERPT",$JOB,$PIECE(DGPDATA,U,5),"NONE")=$GET(^TMP("DGPRERPT",$JOB,$PIECE(DGPDATA,U,5),"NONE"))+1
QUIT
+16 SET ^TMP("DGPRERPT",$JOB,$PIECE(DGPDATA,U,5),$PIECE(DGPDATA,U,4))=$GET(^TMP("DGPRERPT",$JOB,$PIECE(DGPDATA,U,5),$PIECE(DGPDATA,U,4)))+1
End DoDot:3
End DoDot:2
End DoDot:1
+17 ;
+18 DO PRNT
+19 ;
EXIT ;
+1 if '$DATA(ZTQUEUED)
DO ^%ZISC
+2 KILL ^TMP("DGPERPT",$JOB),POP,ZTQUEUED
+3 QUIT
+4 ;
PRNT ; Print report to selected device
+1 NEW DGPDV,SBTOT,SB1,PAGE
+2 ;
+3 SET PAGE=0
+4 IF '$DATA(^TMP("DGPRERPT",$JOB))
Begin DoDot:1
+5 SET DGPDV=""
+6 DO HDR
+7 WRITE !!?10,"No data available"
End DoDot:1
GOTO EXIT
+8 ;
+9 SET DGPDV=""
FOR
SET DGPDV=$ORDER(^TMP("DGPRERPT",$JOB,DGPDV))
if DGPDV']""
QUIT
Begin DoDot:1
+10 DO HDR
if $GET(DGPABRT)
QUIT
+11 SET SBTOT=0
+12 WRITE !?10," BUSY: ",$JUSTIFY(+$GET(^TMP("DGPRERPT",$JOB,DGPDV,"B")),5)
+13 WRITE !?10," CONNECTED: ",$JUSTIFY(+$GET(^TMP("DGPRERPT",$JOB,DGPDV,"C")),5)
+14 WRITE !?10," DEATH: ",$JUSTIFY(+$GET(^TMP("DGPRERPT",$JOB,DGPDV,"D")),5)
+15 WRITE !?10," DON'T CALL: ",$JUSTIFY(+$GET(^TMP("DGPRERPT",$JOB,DGPDV,"T")),5)
+16 WRITE !?10," NO ANSWER: ",$JUSTIFY(+$GET(^TMP("DGPRERPT",$JOB,DGPDV,"N")),5)
+17 WRITE !?10," NO PHONE: ",$JUSTIFY(+$GET(^TMP("DGPRERPT",$JOB,DGPDV,"P")),5)
+18 WRITE !?10," UNCOOPERATIVE: ",$JUSTIFY(+$GET(^TMP("DGPRERPT",$JOB,DGPDV,"U")),5)
+19 WRITE !?10," WRONG NUMBER: ",$JUSTIFY(+$GET(^TMP("DGPRERPT",$JOB,DGPDV,"W")),5)
+20 WRITE !?10,"LEFT A CALLBACK MSG: ",$JUSTIFY(+$GET(^TMP("DGPRERPT",$JOB,DGPDV,"M")),5)
+21 WRITE !?10," CHANGE INFORMATION: ",$JUSTIFY(+$GET(^TMP("DGPRERPT",$JOB,DGPDV,"X")),5)
+22 WRITE !?10," PREVIOUSLY UPDATED: ",$JUSTIFY(+$GET(^TMP("DGPRERPT",$JOB,DGPDV,"V")),5)
+23 WRITE !?10," CALL BACK: ",$JUSTIFY(+$GET(^TMP("DGPRERPT",$JOB,DGPDV,"K")),5)
+24 WRITE !?10," NO STATUS: ",$JUSTIFY(+$GET(^TMP("DGPRERPT",$JOB,DGPDV,"NONE")),5)
+25 WRITE !?10," -------"
+26 SET SB1=""
FOR
SET SB1=$ORDER(^TMP("DGPRERPT",$JOB,DGPDV,SB1))
if SB1']""
QUIT
Begin DoDot:2
+27 SET SBTOT=$GET(SBTOT)++$GET(^TMP("DGPRERPT",$JOB,DGPDV,SB1))
End DoDot:2
+28 WRITE !?10," Total for Division: ",$JUSTIFY(SBTOT,5)
End DoDot:1
if $GET(DGPABRT)
GOTO EXIT
+29 QUIT
+30 ;
HDR ;
+1 IF PAGE>0
IF IOST?1"C-".E
SET DIR(0)="E"
DO ^DIR
SET DGPABRT='+$GET(Y)
+2 if $GET(DGPABRT)
GOTO HDRQ
+3 WRITE @IOF
+4 SET PAGE=PAGE+1
+5 WRITE !!?5,"PRE-REGISTRATION CALL STATISTICS"
+6 if DGPDV]""
WRITE !?5,"FOR",$SELECT($GET(DGSNGLDV):": ",1:" DIVISION: ")
+7 WRITE $SELECT(DGPDV="NO DIV":"NO DIVISION SPECIFIED",+DGPDV>0:$PIECE($GET(^DG(40.8,DGPDV,0)),U),1:"")
+8 ;
+9 WRITE !?5,"FOR PERIOD COVERING "_$$FMTE^XLFDT(DGPBEG,"2D")_" TO "_$$FMTE^XLFDT(DGPEND,"2D")
+10 WRITE !!?5,DGPDSH
HDRQ QUIT
