- 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 Feb 19, 2025@00:17:09 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)