DGPREP5 ;ALB/SCK - PreRegistration Audit field totals ; 10/10/03 3:16pm
;;5.3;Registration;**109,555**;Aug 13, 1993
Q
EN ; Entry point for audit totals by user
N DGPBEG,DGPEND,VAUTD,DGPFLD1,DGPDSH,DGPABRT,DGPLN
K DIR,DIRUT
;
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
S DIR("A")="Enter ending date for report: "
;
AGN 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
;
S %ZIS="Q" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. S ZTRTN="RPT^DGPREP5",ZTDESC="DISPLAY AUDIT FILE TOTALS BY USER"
. S ZTSAVE("DGPBEG")="",ZTSAVE("DGPEND")=""
. S ZTSAVE("VAUTD(")="",ZTSAVE("VAUTD")=""
. D ^%ZTLOAD W:$D(ZTSK) !,"TASK #: ",ZTSK
. D HOME^%ZIS
. K IO("Q"),ZTSK,ZTDESC,ZTRTN,ZTSAVE
;
D WAIT^DICD
;
RPT ; Call procedures to build the data arrays, and then call the print procedure
U IO
S $P(DGPDSH,"=",79)=""
S $P(DGPLN,"-",60)=""
;
K ^TMP("DGPAUD",$J)
K ^TMP("DGPTOT",$J)
;
D BLD2
D BLD3
;
D PRNT(2)
G:$G(DGPABRT) EXIT
D PRNT(2.312)
G:$G(DGPABRT) EXIT
D TOT
;
EXIT ; Clean up and exit
D:'$D(ZTQUEUED) ^%ZISC
K ^TMP("DGPAUD",$J),POP,ZTQUEUED
Q
;
BLD2 ; Build array of audit data for the PATIENT File, #2
N DGPN1,DGPFLD,DGPDATA,DGPDUZ,DGPN2
;
S DGPN1=0
F S DGPN1=$O(^DD(2,DGPN1)) Q:'DGPN1 D
. I $G(^DD(2,DGPN1,"AUDIT"))="y" S DGPFLD(DGPN1)=""
;
S DGPN1=DGPBEG-.1
S DGPE=DGPEND+.999999
F S DGPN1=$O(^DIA(2,"C",DGPN1)) Q:'DGPN1!(DGPN1>DGPE) D
. S DGPN2="" F S DGPN2=$O(^DIA(2,"C",DGPN1,DGPN2)) Q:'DGPN2 D
.. S DGPDATA=$G(^DIA(2,DGPN2,0))
.. Q:$P(DGPDATA,U,3)=""
.. Q:'$D(DGPFLD(+$P($G(DGPDATA),U,3)))
.. S DGPDUZ=+$P($G(DGPDATA),U,4) Q:DGPDUZ'>0
.. Q:'($D(^XUSEC("DGPRE EDIT",DGPDUZ))!($D(^XUSEC("DGPRE SUPV",DGPDUZ))))
.. S ^TMP("DGPAUD",$J,2,+$P(DGPDATA,U,3),DGPDUZ)=+$G(^TMP("DGPAUD",$J,2,+$P(DGPDATA,U,3),DGPDUZ))+1
.. S ^TMP("DGPTOT",$J,DGPDUZ)=+$G(^TMP("DGPTOT",$J,DGPDUZ))+1
Q
;
BLD3 ; Build array of audit data for file 2.312
N DGPN1,DGPE,DGPDATA,DGPDUZ,DGPN2
;
S DGPN1=0
F S DGPN1=$O(^DD(2.312,DGPN1)) Q:'DGPN1 D
. I $G(^DD(2.312,DGPN1,"AUDIT"))="y" S DGPFLD(".3121,"_DGPN1)=""
;
S DGPN1=DGPBEG-.1
S DGPE=DGPEND+.999999
F S DGPN1=$O(^DIA(2,"C",DGPN1)) Q:'DGPN1!(DGPN1>DGPE) D
. S DGPN2="" F S DGPN2=$O(^DIA(2,"C",DGPN1,DGPN2)) Q:'DGPN2 D
.. S DGPDATA=$G(^DIA(2,DGPN2,0))
.. Q:$P(DGPDATA,U,3)=""
.. Q:'$D(DGPFLD($P($G(DGPDATA),U,3)))
.. S DGPDUZ=+$P($G(DGPDATA),U,4) Q:DGPDUZ'>0
.. Q:'($D(^XUSEC("DGPRE EDIT",DGPDUZ))!($D(^XUSEC("DGPRE SUPV",DGPDUZ))))
.. S ^TMP("DGPAUD",$J,2.312,$P(DGPDATA,U,3),DGPDUZ)=+$G(^TMP("DGPAUD",$J,2.312,$P(DGPDATA,U,3),DGPDUZ))+1
.. S ^TMP("DGPTOT",$J,DGPDUZ)=+$G(^TMP("DGPTOT",$J,DGPDUZ))+1
;
Q
;
PRNT(DGPDD) ; Print the report
N DGPFLDX,DGPIENX,DGPTOT
;
S X=$$NEWPGE Q:$G(DGPABRT)
D HDR(DGPDD)
I '$D(^TMP("DGPAUD",$J,DGPDD)) D Q
. W !!?5,"No audit data for this date range"
;
S DGPFLDX=""
F S DGPFLDX=$O(^TMP("DGPAUD",$J,DGPDD,DGPFLDX)) Q:'DGPFLDX D Q:$G(DGPABRT)
. D HDR1(DGPDD,DGPFLDX)
. S DGPIENX="" F S DGPIENX=$O(^TMP("DGPAUD",$J,DGPDD,DGPFLDX,DGPIENX)) Q:'DGPIENX D Q:$G(DGPABRT)
.. I $Y>(IOSL-8) D:$$NEWPGE HDR(DGPDD) Q:$G(DGPABRT)
.. W !?5,$P(^VA(200,DGPIENX,0),U),": ",?50,$J(^TMP("DGPAUD",$J,DGPDD,DGPFLDX,DGPIENX),6)
.. S DGPTOT=$G(DGPTOT)+$G(^TMP("DGPAUD",$J,DGPDD,DGPFLDX,DGPIENX))
. Q:$G(DGPABRT)
. W !!?5,$P(^DD(DGPDD,$S(DGPDD=2:DGPFLDX,1:$P(DGPFLDX,",",2)),0),U)_" (TOTAL): ",?50,$J(DGPTOT,6)
. S DGPTOT=0
. W !?5,DGPLN,!
Q
;
TOT ; Display totals by user
S X=$$NEWPGE Q:$G(DGPABRT)
D HDR(0)
W !!,?2,"User Totals"
W !?2,DGPDSH
S DGPIENX="",DGPTOT=0
F S DGPIENX=$O(^TMP("DGPTOT",$J,DGPIENX)) Q:'DGPIENX D G:$G(DGPABRT) EXIT
. I $Y>(IOSL-8) D:$$NEWPGE HDR(0) Q:$G(DGPABRT)
. W !?5,$P(^VA(200,DGPIENX,0),U),?50,$J(+$G(^TMP("DGPTOT",$J,DGPIENX)),5)
. S DGPTOT=$G(DGPTOT)++$G(^TMP("DGPTOT",$J,DGPIENX))
;
W !!?5,"Total Changes: ",?50,$J(DGPTOT,5)
;
Q
;
HDR(DGPDD) ; Page header
W @IOF
W !?2,"Pre-Registration Audit Totals"
W !?2,"For Period Covering "_$$FMTE^XLFDT(DGPBEG,"2D")_" to "_$$FMTE^XLFDT(DGPEND,"2D")
W !?2,DGPDSH
W !!,?2,$S(DGPDD=2:"Patient Demographic Data --",DGPDD=2.312:"Patient Insurance Data",1:"")
;
Q
;
HDR1(DGPDD,DFLD) ; Field header
I $Y>(IOSL-8) D:$$NEWPGE HDR(DGPDD) G:$G(DGPABRT) EXIT
W !!?5,"**** Field: ",$P(^DD(DGPDD,$S(DGPDD=2.312:$P(DFLD,",",2),1:DFLD),0),U)," ****",!
Q
;
NEWPGE() ; Check for device and execute header if user does not quit
N DIR,DGOK
I IOST?1"C-".E D
. S DIR(0)="E" D ^DIR S DGPABRT='+$G(Y)
. I 'DGPABRT S DGOK=1
Q +$G(DGOK)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPREP5 4994 printed Dec 13, 2024@02:51:07 Page 2
DGPREP5 ;ALB/SCK - PreRegistration Audit field totals ; 10/10/03 3:16pm
+1 ;;5.3;Registration;**109,555**;Aug 13, 1993
+2 QUIT
EN ; Entry point for audit totals by user
+1 NEW DGPBEG,DGPEND,VAUTD,DGPFLD1,DGPDSH,DGPABRT,DGPLN
+2 KILL DIR,DIRUT
+3 ;
+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
+13 SET DIR("A")="Enter ending date for report: "
+14 ;
AGN DO ^DIR
+1 IF $DATA(DIRUT)
GOTO EXIT
+2 SET DGPEND=Y
+3 IF DGPEND<DGPBEG
Begin DoDot:1
+4 WRITE !,"The ending date for this report cannot be earlier then the beginning date"
End DoDot:1
GOTO AGN
+5 ;
+6 KILL DIR
+7 ;
+8 SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO EXIT
+9 IF $DATA(IO("Q"))
Begin DoDot:1
+10 SET ZTRTN="RPT^DGPREP5"
SET ZTDESC="DISPLAY AUDIT FILE TOTALS BY USER"
+11 SET ZTSAVE("DGPBEG")=""
SET ZTSAVE("DGPEND")=""
+12 SET ZTSAVE("VAUTD(")=""
SET ZTSAVE("VAUTD")=""
+13 DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"TASK #: ",ZTSK
+14 DO HOME^%ZIS
+15 KILL IO("Q"),ZTSK,ZTDESC,ZTRTN,ZTSAVE
End DoDot:1
GOTO EXIT
+16 ;
+17 DO WAIT^DICD
+18 ;
RPT ; Call procedures to build the data arrays, and then call the print procedure
+1 USE IO
+2 SET $PIECE(DGPDSH,"=",79)=""
+3 SET $PIECE(DGPLN,"-",60)=""
+4 ;
+5 KILL ^TMP("DGPAUD",$JOB)
+6 KILL ^TMP("DGPTOT",$JOB)
+7 ;
+8 DO BLD2
+9 DO BLD3
+10 ;
+11 DO PRNT(2)
+12 if $GET(DGPABRT)
GOTO EXIT
+13 DO PRNT(2.312)
+14 if $GET(DGPABRT)
GOTO EXIT
+15 DO TOT
+16 ;
EXIT ; Clean up and exit
+1 if '$DATA(ZTQUEUED)
DO ^%ZISC
+2 KILL ^TMP("DGPAUD",$JOB),POP,ZTQUEUED
+3 QUIT
+4 ;
BLD2 ; Build array of audit data for the PATIENT File, #2
+1 NEW DGPN1,DGPFLD,DGPDATA,DGPDUZ,DGPN2
+2 ;
+3 SET DGPN1=0
+4 FOR
SET DGPN1=$ORDER(^DD(2,DGPN1))
if 'DGPN1
QUIT
Begin DoDot:1
+5 IF $GET(^DD(2,DGPN1,"AUDIT"))="y"
SET DGPFLD(DGPN1)=""
End DoDot:1
+6 ;
+7 SET DGPN1=DGPBEG-.1
+8 SET DGPE=DGPEND+.999999
+9 FOR
SET DGPN1=$ORDER(^DIA(2,"C",DGPN1))
if 'DGPN1!(DGPN1>DGPE)
QUIT
Begin DoDot:1
+10 SET DGPN2=""
FOR
SET DGPN2=$ORDER(^DIA(2,"C",DGPN1,DGPN2))
if 'DGPN2
QUIT
Begin DoDot:2
+11 SET DGPDATA=$GET(^DIA(2,DGPN2,0))
+12 if $PIECE(DGPDATA,U,3)=""
QUIT
+13 if '$DATA(DGPFLD(+$PIECE($GET(DGPDATA),U,3)))
QUIT
+14 SET DGPDUZ=+$PIECE($GET(DGPDATA),U,4)
if DGPDUZ'>0
QUIT
+15 if '($DATA(^XUSEC("DGPRE EDIT",DGPDUZ))!($DATA(^XUSEC("DGPRE SUPV",DGPDUZ))))
QUIT
+16 SET ^TMP("DGPAUD",$JOB,2,+$PIECE(DGPDATA,U,3),DGPDUZ)=+$GET(^TMP("DGPAUD",$JOB,2,+$PIECE(DGPDATA,U,3),DGPDUZ))+1
+17 SET ^TMP("DGPTOT",$JOB,DGPDUZ)=+$GET(^TMP("DGPTOT",$JOB,DGPDUZ))+1
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
BLD3 ; Build array of audit data for file 2.312
+1 NEW DGPN1,DGPE,DGPDATA,DGPDUZ,DGPN2
+2 ;
+3 SET DGPN1=0
+4 FOR
SET DGPN1=$ORDER(^DD(2.312,DGPN1))
if 'DGPN1
QUIT
Begin DoDot:1
+5 IF $GET(^DD(2.312,DGPN1,"AUDIT"))="y"
SET DGPFLD(".3121,"_DGPN1)=""
End DoDot:1
+6 ;
+7 SET DGPN1=DGPBEG-.1
+8 SET DGPE=DGPEND+.999999
+9 FOR
SET DGPN1=$ORDER(^DIA(2,"C",DGPN1))
if 'DGPN1!(DGPN1>DGPE)
QUIT
Begin DoDot:1
+10 SET DGPN2=""
FOR
SET DGPN2=$ORDER(^DIA(2,"C",DGPN1,DGPN2))
if 'DGPN2
QUIT
Begin DoDot:2
+11 SET DGPDATA=$GET(^DIA(2,DGPN2,0))
+12 if $PIECE(DGPDATA,U,3)=""
QUIT
+13 if '$DATA(DGPFLD($PIECE($GET(DGPDATA),U,3)))
QUIT
+14 SET DGPDUZ=+$PIECE($GET(DGPDATA),U,4)
if DGPDUZ'>0
QUIT
+15 if '($DATA(^XUSEC("DGPRE EDIT",DGPDUZ))!($DATA(^XUSEC("DGPRE SUPV",DGPDUZ))))
QUIT
+16 SET ^TMP("DGPAUD",$JOB,2.312,$PIECE(DGPDATA,U,3),DGPDUZ)=+$GET(^TMP("DGPAUD",$JOB,2.312,$PIECE(DGPDATA,U,3),DGPDUZ))+1
+17 SET ^TMP("DGPTOT",$JOB,DGPDUZ)=+$GET(^TMP("DGPTOT",$JOB,DGPDUZ))+1
End DoDot:2
End DoDot:1
+18 ;
+19 QUIT
+20 ;
PRNT(DGPDD) ; Print the report
+1 NEW DGPFLDX,DGPIENX,DGPTOT
+2 ;
+3 SET X=$$NEWPGE
if $GET(DGPABRT)
QUIT
+4 DO HDR(DGPDD)
+5 IF '$DATA(^TMP("DGPAUD",$JOB,DGPDD))
Begin DoDot:1
+6 WRITE !!?5,"No audit data for this date range"
End DoDot:1
QUIT
+7 ;
+8 SET DGPFLDX=""
+9 FOR
SET DGPFLDX=$ORDER(^TMP("DGPAUD",$JOB,DGPDD,DGPFLDX))
if 'DGPFLDX
QUIT
Begin DoDot:1
+10 DO HDR1(DGPDD,DGPFLDX)
+11 SET DGPIENX=""
FOR
SET DGPIENX=$ORDER(^TMP("DGPAUD",$JOB,DGPDD,DGPFLDX,DGPIENX))
if 'DGPIENX
QUIT
Begin DoDot:2
+12 IF $Y>(IOSL-8)
if $$NEWPGE
DO HDR(DGPDD)
if $GET(DGPABRT)
QUIT
+13 WRITE !?5,$PIECE(^VA(200,DGPIENX,0),U),": ",?50,$JUSTIFY(^TMP("DGPAUD",$JOB,DGPDD,DGPFLDX,DGPIENX),6)
+14 SET DGPTOT=$GET(DGPTOT)+$GET(^TMP("DGPAUD",$JOB,DGPDD,DGPFLDX,DGPIENX))
End DoDot:2
if $GET(DGPABRT)
QUIT
+15 if $GET(DGPABRT)
QUIT
+16 WRITE !!?5,$PIECE(^DD(DGPDD,$SELECT(DGPDD=2:DGPFLDX,1:$PIECE(DGPFLDX,",",2)),0),U)_" (TOTAL): ",?50,$JUSTIFY(DGPTOT,6)
+17 SET DGPTOT=0
+18 WRITE !?5,DGPLN,!
End DoDot:1
if $GET(DGPABRT)
QUIT
+19 QUIT
+20 ;
TOT ; Display totals by user
+1 SET X=$$NEWPGE
if $GET(DGPABRT)
QUIT
+2 DO HDR(0)
+3 WRITE !!,?2,"User Totals"
+4 WRITE !?2,DGPDSH
+5 SET DGPIENX=""
SET DGPTOT=0
+6 FOR
SET DGPIENX=$ORDER(^TMP("DGPTOT",$JOB,DGPIENX))
if 'DGPIENX
QUIT
Begin DoDot:1
+7 IF $Y>(IOSL-8)
if $$NEWPGE
DO HDR(0)
if $GET(DGPABRT)
QUIT
+8 WRITE !?5,$PIECE(^VA(200,DGPIENX,0),U),?50,$JUSTIFY(+$GET(^TMP("DGPTOT",$JOB,DGPIENX)),5)
+9 SET DGPTOT=$GET(DGPTOT)++$GET(^TMP("DGPTOT",$JOB,DGPIENX))
End DoDot:1
if $GET(DGPABRT)
GOTO EXIT
+10 ;
+11 WRITE !!?5,"Total Changes: ",?50,$JUSTIFY(DGPTOT,5)
+12 ;
+13 QUIT
+14 ;
HDR(DGPDD) ; Page header
+1 WRITE @IOF
+2 WRITE !?2,"Pre-Registration Audit Totals"
+3 WRITE !?2,"For Period Covering "_$$FMTE^XLFDT(DGPBEG,"2D")_" to "_$$FMTE^XLFDT(DGPEND,"2D")
+4 WRITE !?2,DGPDSH
+5 WRITE !!,?2,$SELECT(DGPDD=2:"Patient Demographic Data --",DGPDD=2.312:"Patient Insurance Data",1:"")
+6 ;
+7 QUIT
+8 ;
HDR1(DGPDD,DFLD) ; Field header
+1 IF $Y>(IOSL-8)
if $$NEWPGE
DO HDR(DGPDD)
if $GET(DGPABRT)
GOTO EXIT
+2 WRITE !!?5,"**** Field: ",$PIECE(^DD(DGPDD,$SELECT(DGPDD=2.312:$PIECE(DFLD,",",2),1:DFLD),0),U)," ****",!
+3 QUIT
+4 ;
NEWPGE() ; Check for device and execute header if user does not quit
+1 NEW DIR,DGOK
+2 IF IOST?1"C-".E
Begin DoDot:1
+3 SET DIR(0)="E"
DO ^DIR
SET DGPABRT='+$GET(Y)
+4 IF 'DGPABRT
SET DGOK=1
End DoDot:1
+5 QUIT +$GET(DGOK)
