Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPREP5

DGPREP5.m

Go to the documentation of this file.
  1. DGPREP5 ;ALB/SCK - PreRegistration Audit field totals ; 10/10/03 3:16pm
  1. ;;5.3;Registration;**109,555**;Aug 13, 1993
  1. Q
  1. EN ; Entry point for audit totals by user
  1. N DGPBEG,DGPEND,VAUTD,DGPFLD1,DGPDSH,DGPABRT,DGPLN
  1. K DIR,DIRUT
  1. ;
  1. S DIR(0)="DA^::EX"
  1. S X1=$P($$NOW^XLFDT,".")
  1. S DIR("?",1)="Enter the beginning or ending date in an acceptable format"
  1. S DIR("?")="The ending date cannot be before the beginning date."
  1. S DIR("B")=$$FMTE^XLFDT(X1,1)
  1. S DIR("A")="Enter beginning date for report: "
  1. D ^DIR
  1. I $D(DIRUT) G EXIT
  1. S DGPBEG=Y
  1. S DIR("A")="Enter ending date for report: "
  1. ;
  1. AGN D ^DIR
  1. I $D(DIRUT) G EXIT
  1. S DGPEND=Y
  1. I DGPEND<DGPBEG D G AGN
  1. . W !,"The ending date for this report cannot be earlier then the beginning date"
  1. ;
  1. K DIR
  1. ;
  1. S %ZIS="Q" D ^%ZIS G:POP EXIT
  1. I $D(IO("Q")) D G EXIT
  1. . S ZTRTN="RPT^DGPREP5",ZTDESC="DISPLAY AUDIT FILE TOTALS BY USER"
  1. . S ZTSAVE("DGPBEG")="",ZTSAVE("DGPEND")=""
  1. . S ZTSAVE("VAUTD(")="",ZTSAVE("VAUTD")=""
  1. . D ^%ZTLOAD W:$D(ZTSK) !,"TASK #: ",ZTSK
  1. . D HOME^%ZIS
  1. . K IO("Q"),ZTSK,ZTDESC,ZTRTN,ZTSAVE
  1. ;
  1. D WAIT^DICD
  1. ;
  1. RPT ; Call procedures to build the data arrays, and then call the print procedure
  1. U IO
  1. S $P(DGPDSH,"=",79)=""
  1. S $P(DGPLN,"-",60)=""
  1. ;
  1. K ^TMP("DGPAUD",$J)
  1. K ^TMP("DGPTOT",$J)
  1. ;
  1. D BLD2
  1. D BLD3
  1. ;
  1. D PRNT(2)
  1. G:$G(DGPABRT) EXIT
  1. D PRNT(2.312)
  1. G:$G(DGPABRT) EXIT
  1. D TOT
  1. ;
  1. EXIT ; Clean up and exit
  1. D:'$D(ZTQUEUED) ^%ZISC
  1. K ^TMP("DGPAUD",$J),POP,ZTQUEUED
  1. Q
  1. ;
  1. BLD2 ; Build array of audit data for the PATIENT File, #2
  1. N DGPN1,DGPFLD,DGPDATA,DGPDUZ,DGPN2
  1. ;
  1. S DGPN1=0
  1. F S DGPN1=$O(^DD(2,DGPN1)) Q:'DGPN1 D
  1. . I $G(^DD(2,DGPN1,"AUDIT"))="y" S DGPFLD(DGPN1)=""
  1. ;
  1. S DGPN1=DGPBEG-.1
  1. S DGPE=DGPEND+.999999
  1. F S DGPN1=$O(^DIA(2,"C",DGPN1)) Q:'DGPN1!(DGPN1>DGPE) D
  1. . S DGPN2="" F S DGPN2=$O(^DIA(2,"C",DGPN1,DGPN2)) Q:'DGPN2 D
  1. .. S DGPDATA=$G(^DIA(2,DGPN2,0))
  1. .. Q:$P(DGPDATA,U,3)=""
  1. .. Q:'$D(DGPFLD(+$P($G(DGPDATA),U,3)))
  1. .. S DGPDUZ=+$P($G(DGPDATA),U,4) Q:DGPDUZ'>0
  1. .. Q:'($D(^XUSEC("DGPRE EDIT",DGPDUZ))!($D(^XUSEC("DGPRE SUPV",DGPDUZ))))
  1. .. S ^TMP("DGPAUD",$J,2,+$P(DGPDATA,U,3),DGPDUZ)=+$G(^TMP("DGPAUD",$J,2,+$P(DGPDATA,U,3),DGPDUZ))+1
  1. .. S ^TMP("DGPTOT",$J,DGPDUZ)=+$G(^TMP("DGPTOT",$J,DGPDUZ))+1
  1. Q
  1. ;
  1. BLD3 ; Build array of audit data for file 2.312
  1. N DGPN1,DGPE,DGPDATA,DGPDUZ,DGPN2
  1. ;
  1. S DGPN1=0
  1. F S DGPN1=$O(^DD(2.312,DGPN1)) Q:'DGPN1 D
  1. . I $G(^DD(2.312,DGPN1,"AUDIT"))="y" S DGPFLD(".3121,"_DGPN1)=""
  1. ;
  1. S DGPN1=DGPBEG-.1
  1. S DGPE=DGPEND+.999999
  1. F S DGPN1=$O(^DIA(2,"C",DGPN1)) Q:'DGPN1!(DGPN1>DGPE) D
  1. . S DGPN2="" F S DGPN2=$O(^DIA(2,"C",DGPN1,DGPN2)) Q:'DGPN2 D
  1. .. S DGPDATA=$G(^DIA(2,DGPN2,0))
  1. .. Q:$P(DGPDATA,U,3)=""
  1. .. Q:'$D(DGPFLD($P($G(DGPDATA),U,3)))
  1. .. S DGPDUZ=+$P($G(DGPDATA),U,4) Q:DGPDUZ'>0
  1. .. Q:'($D(^XUSEC("DGPRE EDIT",DGPDUZ))!($D(^XUSEC("DGPRE SUPV",DGPDUZ))))
  1. .. S ^TMP("DGPAUD",$J,2.312,$P(DGPDATA,U,3),DGPDUZ)=+$G(^TMP("DGPAUD",$J,2.312,$P(DGPDATA,U,3),DGPDUZ))+1
  1. .. S ^TMP("DGPTOT",$J,DGPDUZ)=+$G(^TMP("DGPTOT",$J,DGPDUZ))+1
  1. ;
  1. Q
  1. ;
  1. PRNT(DGPDD) ; Print the report
  1. N DGPFLDX,DGPIENX,DGPTOT
  1. ;
  1. S X=$$NEWPGE Q:$G(DGPABRT)
  1. D HDR(DGPDD)
  1. I '$D(^TMP("DGPAUD",$J,DGPDD)) D Q
  1. . W !!?5,"No audit data for this date range"
  1. ;
  1. S DGPFLDX=""
  1. F S DGPFLDX=$O(^TMP("DGPAUD",$J,DGPDD,DGPFLDX)) Q:'DGPFLDX D Q:$G(DGPABRT)
  1. . D HDR1(DGPDD,DGPFLDX)
  1. . S DGPIENX="" F S DGPIENX=$O(^TMP("DGPAUD",$J,DGPDD,DGPFLDX,DGPIENX)) Q:'DGPIENX D Q:$G(DGPABRT)
  1. .. I $Y>(IOSL-8) D:$$NEWPGE HDR(DGPDD) Q:$G(DGPABRT)
  1. .. W !?5,$P(^VA(200,DGPIENX,0),U),": ",?50,$J(^TMP("DGPAUD",$J,DGPDD,DGPFLDX,DGPIENX),6)
  1. .. S DGPTOT=$G(DGPTOT)+$G(^TMP("DGPAUD",$J,DGPDD,DGPFLDX,DGPIENX))
  1. . Q:$G(DGPABRT)
  1. . W !!?5,$P(^DD(DGPDD,$S(DGPDD=2:DGPFLDX,1:$P(DGPFLDX,",",2)),0),U)_" (TOTAL): ",?50,$J(DGPTOT,6)
  1. . S DGPTOT=0
  1. . W !?5,DGPLN,!
  1. Q
  1. ;
  1. TOT ; Display totals by user
  1. S X=$$NEWPGE Q:$G(DGPABRT)
  1. D HDR(0)
  1. W !!,?2,"User Totals"
  1. W !?2,DGPDSH
  1. S DGPIENX="",DGPTOT=0
  1. F S DGPIENX=$O(^TMP("DGPTOT",$J,DGPIENX)) Q:'DGPIENX D G:$G(DGPABRT) EXIT
  1. . I $Y>(IOSL-8) D:$$NEWPGE HDR(0) Q:$G(DGPABRT)
  1. . W !?5,$P(^VA(200,DGPIENX,0),U),?50,$J(+$G(^TMP("DGPTOT",$J,DGPIENX)),5)
  1. . S DGPTOT=$G(DGPTOT)++$G(^TMP("DGPTOT",$J,DGPIENX))
  1. ;
  1. W !!?5,"Total Changes: ",?50,$J(DGPTOT,5)
  1. ;
  1. Q
  1. ;
  1. HDR(DGPDD) ; Page header
  1. W @IOF
  1. W !?2,"Pre-Registration Audit Totals"
  1. W !?2,"For Period Covering "_$$FMTE^XLFDT(DGPBEG,"2D")_" to "_$$FMTE^XLFDT(DGPEND,"2D")
  1. W !?2,DGPDSH
  1. W !!,?2,$S(DGPDD=2:"Patient Demographic Data --",DGPDD=2.312:"Patient Insurance Data",1:"")
  1. ;
  1. Q
  1. ;
  1. HDR1(DGPDD,DFLD) ; Field header
  1. I $Y>(IOSL-8) D:$$NEWPGE HDR(DGPDD) G:$G(DGPABRT) EXIT
  1. W !!?5,"**** Field: ",$P(^DD(DGPDD,$S(DGPDD=2.312:$P(DFLD,",",2),1:DFLD),0),U)," ****",!
  1. Q
  1. ;
  1. NEWPGE() ; Check for device and execute header if user does not quit
  1. N DIR,DGOK
  1. I IOST?1"C-".E D
  1. . S DIR(0)="E" D ^DIR S DGPABRT='+$G(Y)
  1. . I 'DGPABRT S DGOK=1
  1. Q +$G(DGOK)