AGERRAU1 ;IHS/OIT/NKD - EDIT CHECK ERROR AUDIT CAPTURE AND PRINT ROUTINE - CONTINUED; FEBRUARY 10, 2014
;;7.1;PATIENT REGISTRATION;**11**;AUG 25, 2005;Build 1
;IHS/OIT/NKD AG*7.1*11 DISPLAY ENTIRE CORRECTIVE ACTION FIELD
;NEW ROUTINE TO HANDLE OVERFLOW FROM AGERRAUD PER SAC
;
SUMMARY ;EP - NOW PRINT SUMMARY
S ESCAPE=0
S FAC=0
F S FAC=$O(^XTMP("AGERRAUD",$J,FAC)) Q:'FAC D Q:ESCAPE
.S ERRTYPE=$O(^XTMP("AGERRAUD",$J,FAC,""))
.;D PRTHDR,ALLHDR
.S ERRTYPE="",ERROLD=""
.F S ERRTYPE=$O(^XTMP("AGERRAUD",$J,FAC,ERRTYPE)) Q:ERRTYPE="" D Q:ESCAPE
..I ERRTYPE'=ERROLD S ERROLD=ERRTYPE D PRTHDR,ALLHDR
..S ERRCODE=""
..F S ERRCODE=$O(^XTMP("AGERRAUD",$J,FAC,ERRTYPE,ERRCODE)) Q:ERRCODE="" D Q:ESCAPE
...S NUMPT=$G(^XTMP("AGERRAUD",$J,FAC,ERRTYPE,ERRCODE))
...S ERRNODE=$G(^AGEDERRS(ERRCODE,0))
...S ERRDESCR=$P(ERRNODE,U,3)
...S X=ERRCODE
...S X="000"_X
...W !?0,$E(X,$L(X)-2,$L(X))
...W ?10,$E(ERRDESCR,1,54)
...W ?68,$J(NUMPT,8)
...;NOTE: HEADER IS 8 LINES
...I ($Y>(IOSL-4)!($Y=(IOSL-4))),(IOST[("C-")) W ! K DIR S DIR(0)="E" D:'ESCAPE ^DIR S ESCAPE=X=U Q:'$O(^XTMP("AGERRAUD",$J,FAC,ERRTYPE,ERRCODE)) D:'ESCAPE PRTHDR,ALLHDR Q
...I $Y>(IOSL-4)!($Y=(IOSL-4)) Q:'$O(^XTMP("AGERRAUD",$J,FAC,ERRTYPE,ERRCODE)) D PRTHDR,ALLHDR
..I (IOST[("C-")) W ! K DIR S DIR(0)="E" D ^DIR S ESCAPE=X=U Q
D ^%ZISC
Q
HDR ;EP
W @IOF
D CENTER("PATIENT REGISTRATION")
W !!
;D CENTER($G(^DIC(4,DUZ(2),0),U)) ;NO IM FOUND DURING DEVLOPEMENT
D CENTER($P($G(^DIC(4,DUZ(2),0)),U)) ;IHS/SD/TPF 3/30/2006 AG*7.1*2
W !!
D CENTER("ERROR / WARNING REPORT")
Q
CENTER(X) ;EP -
S CENTER=IOM/2
W ?CENTER-($L(X)/2),X
Q
ALLHDR ;EP
W !,$S(ERRTYPE="E":"ERROR",1:"WARNING"),?63,"total # of"
W !,"NUMBER",?15,"ERROR LIST",?63,"Patient w/Errors"
W !,"------",?10,"---------------------------------------------",?63,"--------------"
Q
DETHDR(ERRCODE) ;EP
W !!
S ERRNODE=$G(^AGEDERRS(ERRCODE,0))
S ERRDESCR=$P(ERRNODE,U,3)
S X=ERRCODE
S X="000"_X
W !?0,$E(X,$L(X)-2,$L(X))
W ?4,$S(ERRTYPE="E":"ERROR",1:"WARNING")_":"
W ?17,ERRDESCR
W !?0,"CORRECTIVE ACTION:"
;IHS/OIT/NKD AG*7.1*11 DISPLAY ENTIRE CORRECTIVE ACTION FIELD - START NEW CODE
;D WRAP^AGUTILS($G(^AGEDERRS(ERRCODE,1,1,0)),20,"WC50")
N AGCOR,AGCNT
S AGCOR=$$GET1^DIQ(9009061.5,ERRCODE_",",501,,"AGCOR"),AGCOR="",AGCNT=0
F S AGCNT=$O(AGCOR(AGCNT)) Q:'AGCNT S AGCOR=AGCOR_AGCOR(AGCNT)
D WRAP^AGUTILS(AGCOR,20,"WC50")
;IHS/OIT/NKD AG*7.1*11 END NEW CODE
W !,AGLINE("EQ")
W !,?4,"Name",?22,"IHS #",?37,"FACILITY",?69,"DOB"
W !,AGLINE("EQ")
Q
PRTHDR ;EP
W @IOF
W !
;D CENTER($G(^DIC(4,FAC,0),U)) ;NO IM FOUND DURING DEVLOPEMENT
D CENTER($P($G(^DIC(4,FAC,0)),U)) ;IHS/SD/TPF 3/30/2006 AG*7.1*2
S PGNUM=PGNUM+1
W ?69,"PAGE ",PGNUM
W !!
D CENTER("Patient Registration Errors/Warnings")
W !
D CENTER("AUDIT "_$S(RPTTYPE="S":"SUMMARY",1:"DETAIL")_" REPORT")
W !
D CENTER(REPTIME)
Q
AGERRAU1 ;IHS/OIT/NKD - EDIT CHECK ERROR AUDIT CAPTURE AND PRINT ROUTINE - CONTINUED; FEBRUARY 10, 2014
+1 ;;7.1;PATIENT REGISTRATION;**11**;AUG 25, 2005;Build 1
+2 ;IHS/OIT/NKD AG*7.1*11 DISPLAY ENTIRE CORRECTIVE ACTION FIELD
+3 ;NEW ROUTINE TO HANDLE OVERFLOW FROM AGERRAUD PER SAC
+4 ;
SUMMARY ;EP - NOW PRINT SUMMARY
+1 SET ESCAPE=0
+2 SET FAC=0
+3 FOR
SET FAC=$ORDER(^XTMP("AGERRAUD",$JOB,FAC))
IF 'FAC
QUIT
Begin DoDot:1
+4 SET ERRTYPE=$ORDER(^XTMP("AGERRAUD",$JOB,FAC,""))
+5 ;D PRTHDR,ALLHDR
+6 SET ERRTYPE=""
SET ERROLD=""
+7 FOR
SET ERRTYPE=$ORDER(^XTMP("AGERRAUD",$JOB,FAC,ERRTYPE))
IF ERRTYPE=""
QUIT
Begin DoDot:2
+8 IF ERRTYPE'=ERROLD
SET ERROLD=ERRTYPE
DO PRTHDR
DO ALLHDR
+9 SET ERRCODE=""
+10 FOR
SET ERRCODE=$ORDER(^XTMP("AGERRAUD",$JOB,FAC,ERRTYPE,ERRCODE))
IF ERRCODE=""
QUIT
Begin DoDot:3
+11 SET NUMPT=$GET(^XTMP("AGERRAUD",$JOB,FAC,ERRTYPE,ERRCODE))
+12 SET ERRNODE=$GET(^AGEDERRS(ERRCODE,0))
+13 SET ERRDESCR=$PIECE(ERRNODE,U,3)
+14 SET X=ERRCODE
+15 SET X="000"_X
+16 WRITE !?0,$EXTRACT(X,$LENGTH(X)-2,$LENGTH(X))
+17 WRITE ?10,$EXTRACT(ERRDESCR,1,54)
+18 WRITE ?68,$JUSTIFY(NUMPT,8)
+19 ;NOTE: HEADER IS 8 LINES
+20 IF ($Y>(IOSL-4)!($Y=(IOSL-4)))
IF (IOST[("C-"))
WRITE !
KILL DIR
SET DIR(0)="E"
IF 'ESCAPE
DO ^DIR
SET ESCAPE=X=U
IF '$ORDER(^XTMP("AGERRAUD",$JOB,FAC,ERRTYPE,ERRCODE))
QUIT
IF 'ESCAPE
DO PRTHDR
DO ALLHDR
QUIT
+21 IF $Y>(IOSL-4)!($Y=(IOSL-4))
IF '$ORDER(^XTMP("AGERRAUD",$JOB,FAC,ERRTYPE,ERRCODE))
QUIT
DO PRTHDR
DO ALLHDR
End DoDot:3
IF ESCAPE
QUIT
+22 IF (IOST[("C-"))
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
SET ESCAPE=X=U
QUIT
End DoDot:2
IF ESCAPE
QUIT
End DoDot:1
IF ESCAPE
QUIT
+23 DO ^%ZISC
+24 QUIT
HDR ;EP
+1 WRITE @IOF
+2 DO CENTER("PATIENT REGISTRATION")
+3 WRITE !!
+4 ;D CENTER($G(^DIC(4,DUZ(2),0),U)) ;NO IM FOUND DURING DEVLOPEMENT
+5 ;IHS/SD/TPF 3/30/2006 AG*7.1*2
DO CENTER($PIECE($GET(^DIC(4,DUZ(2),0)),U))
+6 WRITE !!
+7 DO CENTER("ERROR / WARNING REPORT")
+8 QUIT
CENTER(X) ;EP -
+1 SET CENTER=IOM/2
+2 WRITE ?CENTER-($LENGTH(X)/2),X
+3 QUIT
ALLHDR ;EP
+1 WRITE !,$SELECT(ERRTYPE="E":"ERROR",1:"WARNING"),?63,"total # of"
+2 WRITE !,"NUMBER",?15,"ERROR LIST",?63,"Patient w/Errors"
+3 WRITE !,"------",?10,"---------------------------------------------",?63,"--------------"
+4 QUIT
DETHDR(ERRCODE) ;EP
+1 WRITE !!
+2 SET ERRNODE=$GET(^AGEDERRS(ERRCODE,0))
+3 SET ERRDESCR=$PIECE(ERRNODE,U,3)
+4 SET X=ERRCODE
+5 SET X="000"_X
+6 WRITE !?0,$EXTRACT(X,$LENGTH(X)-2,$LENGTH(X))
+7 WRITE ?4,$SELECT(ERRTYPE="E":"ERROR",1:"WARNING")_":"
+8 WRITE ?17,ERRDESCR
+9 WRITE !?0,"CORRECTIVE ACTION:"
+10 ;IHS/OIT/NKD AG*7.1*11 DISPLAY ENTIRE CORRECTIVE ACTION FIELD - START NEW CODE
+11 ;D WRAP^AGUTILS($G(^AGEDERRS(ERRCODE,1,1,0)),20,"WC50")
+12 NEW AGCOR,AGCNT
+13 SET AGCOR=$$GET1^DIQ(9009061.5,ERRCODE_",",501,,"AGCOR")
SET AGCOR=""
SET AGCNT=0
+14 FOR
SET AGCNT=$ORDER(AGCOR(AGCNT))
IF 'AGCNT
QUIT
SET AGCOR=AGCOR_AGCOR(AGCNT)
+15 DO WRAP^AGUTILS(AGCOR,20,"WC50")
+16 ;IHS/OIT/NKD AG*7.1*11 END NEW CODE
+17 WRITE !,AGLINE("EQ")
+18 WRITE !,?4,"Name",?22,"IHS #",?37,"FACILITY",?69,"DOB"
+19 WRITE !,AGLINE("EQ")
+20 QUIT
PRTHDR ;EP
+1 WRITE @IOF
+2 WRITE !
+3 ;D CENTER($G(^DIC(4,FAC,0),U)) ;NO IM FOUND DURING DEVLOPEMENT
+4 ;IHS/SD/TPF 3/30/2006 AG*7.1*2
DO CENTER($PIECE($GET(^DIC(4,FAC,0)),U))
+5 SET PGNUM=PGNUM+1
+6 WRITE ?69,"PAGE ",PGNUM
+7 WRITE !!
+8 DO CENTER("Patient Registration Errors/Warnings")
+9 WRITE !
+10 DO CENTER("AUDIT "_$SELECT(RPTTYPE="S":"SUMMARY",1:"DETAIL")_" REPORT")
+11 WRITE !
+12 DO CENTER(REPTIME)
+13 QUIT
