DGRPECE2 ;ALB/MRY - REGISTRATION CATASTROPHIC EDITS REPORT ; 11/16/04 9:00am
;;5.3;Registration;**638,831**;Aug 13, 1993;Build 10
;
N DIR,DGFMT,DGFMTD
FMT K DIR S DIR("A")="Select report format",DIR(0)="S^D:DETAILED;S:SUMMARY"
S DIR("?",1)="DETAILED format allows the selected listing of all processed alerts, alerts"
S DIR("?",2)="not reviewed, or alerts determined to be catastrophic alerts. SUMMARY format"
S DIR("?",3)="allows the cumulative totals of processed alerts, alerts reviewed, and alerts"
S DIR("?")="determined to be catastrophic edits."
S DIR("B")="SUMMARY" D ^DIR Q:$D(DIRUT)
S DGFMT=Y,DGFMTD=""
I DGFMT="D" D
. K DIR S DIR("A")="Select detailed category",DIR(0)="S^1:ALL;2:NOT REVIEWED;3:CATASTROPHIC EDIT ONLY"
. S DIR("?",1)="ALL category will display all alerts in unreviewed, reviewed catastrophic."
. S DIR("?",2)="NOT REVIEWED will display all alerts that have not been reviewed."
. S DIR("?",3)="CATASTROPHIC EDIT ONLY category will display those alerts that were deemed"
. S DIR("?",4)="to be a catastrophic edit."
. S DIR("B")="ALL" D ^DIR
. S DGFMTD=Y
;
FDT W !!,"***CATASTROPHIC EDIT ALERTS ARE ONLY RETAINED FOR 365 DAYS.***"
FDT1 S %DT="AEPX",%DT("A")="Beginning Date: " D ^%DT I X=U!($D(DTOUT)) Q
G:Y<1 FDT1 S DGS1=Y X ^DD("DD") S DGBEG=DGS1_U_Y
LDT W ! S %DT("A")=" Ending Date: " D ^%DT I X=U!($D(DTOUT)) Q
I Y<$P(DGBEG,U) W !!,$C(7),"Ending date must be after beginning date!" G LDT
S DGS1=Y X ^DD("DD") S DGEND=DGS1_U_Y
S DGTAG=$S(DGFMT="S":"SUMMARY",1:"DETAIL")
S DGVAR="DGBEG^DGEND^DGFMT^DGFMTD",DGPGM="START^DGRPECE2" W ! D ZIS^DGUTQ I 'POP U IO G START^DGRPECE2
K %DT,DGBEG,DGEND,DGVAR,DGPGM,DGTAG,DGFMT,DGS1,DGFMTD,DIR,POP,X,Y D CLOSE^DGUTQ Q
;
START ;
N DGICN,DGADT,DGIEN,DGDT,HDR,HDR2,HDRS,DGSDT,DGEDT,DGTA,DGTR,DGTC,DGPG,DGDATA,DIR,DGT,DGQUIT,XQAID,DGA
D NOW^%DTC S Y=$E(%,1,12) S DGDT=$$FMTE^XLFDT(Y,1)
S HDR="POTENTIAL CATASTROPHIC EDIT OF PATIENT IDENTIFYING DATA"
I DGFMT="S" S HDR=HDR_" SUMMARY REPORT"
I DGFMT="D" S HDR=HDR_" DETAILED REPORT"
I DGFMT="D" S HDR2="(Category: "_$S(DGFMTD=1:"ALL",DGFMTD=2:"NOT REVIEWED",DGFMTD=3:"CATASTROPHIC EDITS",1:"")_")"
;
S DGSDT=+DGBEG-.0001,DGEDT=+DGEND_.9999
S (DGTA,DGTR,DGTC,DGPG)=0 K ^TMP($J,"DGRPECE")
F S DGSDT=$O(^XTV(8992.1,"D",DGSDT)) Q:'DGSDT!(DGSDT>DGEDT) S DGIEN=0 F S DGIEN=$O(^(DGSDT,DGIEN)) Q:'DGIEN D
. I $$GET1^DIQ(8992.1,+DGIEN_",",1.04)'="DGRPECE1" Q
. S DGTA=DGTA+1
. S DGDATA=$$GET1^DIQ(8992.1,+DGIEN_",",2)
. S DGTR=DGTR+$S($P(DGDATA,U,15)'="":1,1:0)
. S DGTC=DGTC+$S($P(DGDATA,U,16)=1:1,1:0)
. S DGICN=$$GETICN^MPIF001($P($P(DGDATA,U,12),";"))
. I DGFMTD=1 D
.. S ^TMP($J,"DGRPECE",DGICN,DGSDT,+DGIEN)=""
. I DGFMTD=2,$P(DGDATA,U,15)="" D
.. S ^TMP($J,"DGRPECE",DGICN,DGSDT,+DGIEN)=""
. I DGFMTD=3,$P(DGDATA,U,16)=1 D
.. S ^TMP($J,"DGRPECE",DGICN,DGSDT,+DGIEN)=""
;
D HEAD
SUMMARY ;print summary
W !!,"TOTAL 'POTENTIAL CATASTROPHIC EDIT' ALERTS POSTED: ",DGTA
W !,"TOTAL 'POTENTIAL CATASTROPHIC EDIT' ALERTS REVIEWED: ",DGTR
W !,"TOTAL 'POTENTIAL CATASTROPHIC EDIT' ALERTS DETERMINED TO BE CATASTROPHIC: ",DGTC
I $O(^TMP($J,"DGRPECE",""))=""!(DGFMT="S") D G QUIT
. K DIR I IOST?1"C-".E S DIR(0)="E" D ^DIR K DIR(0)
;
DETAIL ;Print detail
W !!,$TR($J("",IOM)," ","*")
S HDRS="***** <POTENTIAL CATASTROPHIC EDIT OF IDENTIFYING DATA> *****"
W !?(IOM-$L(HDRS)/2),HDRS,!
S DGICN=0 F S DGICN=$O(^TMP($J,"DGRPECE",DGICN)) Q:DGICN="" D Q:DGQUIT
. S DGADT=0 F S DGADT=$O(^TMP($J,"DGRPECE",DGICN,DGADT)) Q:'DGADT D Q:DGQUIT
.. S DGIEN=0 F S DGIEN=$O(^TMP($J,"DGRPECE",DGICN,DGADT,DGIEN)) Q:'DGIEN D Q:DGQUIT
... S XQAID=$$GET1^DIQ(8992.1,+DGIEN_",",.01)
... D ALERTDAT^XQALBUTL(XQAID,"DGA")
... W ! D CHKL Q:DGQUIT
... W !,"Patient: "_$P($P(DGA(2),U,8),";")_" (ICN: "_DGICN_")",?60,"Station: ",$P(DGA(2),U,13) D CHKL Q:DGQUIT
... W !,$TR($J("",IOM)," ","-") D CHKL Q:DGQUIT
... W !?3,"Patient Identification (before edit)" D CHKL Q:DGQUIT
... W !?4,"Name: ",$P(DGA(2),U),?45,"Soc. Security Number: ",$P(DGA(2),U,2) D CHKL Q:DGQUIT
... W !?4,"Date of Birth: ",$$DATE4^DGRPECE1($P(DGA(2),U,3)),?45,"Gender: ",$S($P(DGA(2),U,4)="M":"MALE",$P(DGA(2),U,4)="F":"FEMALE",1:$P(DGA(2),U,4)) D CHKL Q:DGQUIT
... W !?4,"Mother's Maiden Name: ",$P(DGA(2),U,5) D CHKL Q:DGQUIT
... W !?4,"Place of Birth [city]: ",$P(DGA(2),U,6) D CHKL Q:DGQUIT
... W !?4,"Place of Birth [state]: " I $P(DGA(2),U,7) W $P(^DIC(5,$P(DGA(2),U,7),0),U) D CHKL Q:DGQUIT
... W ! D CHKL Q:DGQUIT
... W !?3,"Patient Identification fields (after edit)" D CHKL Q:DGQUIT
... W !?3 W:$P($P(DGA(2),U,8),";",2)="*" "*" W ?4,"Name: ",$P($P(DGA(2),U,8),";") W ?44 W:$P($P(DGA(2),U,9),";",2)="*" "*" W ?45,"Soc. Security Number: ",$P($P(DGA(2),U,9),";")
... D CHKL Q:DGQUIT
... W !?3 W:$P($P(DGA(2),U,10),";",2)="*" "*" W ?4,"Date of Birth: ",$$DATE4^DGRPECE1($P($P(DGA(2),U,10),";"))
... W ?44 W:$P($P(DGA(2),U,11),";",2)="*" "*" W ?45,"Gender: ",$S($P($P(DGA(2),U,11),";")="M":"MALE",$P($P(DGA(2),U,11),";")="F":"FEMALE",1:"")
... D CHKL Q:DGQUIT
... W ! D CHKL Q:DGQUIT
... W !?3,"Edited by: ",$P(DGA(.05),U,2),?45,"Generated: ",$P(DGA(.02),U,2) D CHKL Q:DGQUIT
... W !?3,"With Option: ",$$GET1^DIQ(19,+$P(DGA(2),U,14)_",",.01) D CHKL Q:DGQUIT
... W !?3,"Reviewed by: " W:$P(DGA(2),U,15) $P(^VA(200,$P(DGA(2),U,15),0),U)
... W:$P(DGA(2),U,15) ?45,"Catastrophic Edit: ",$S($P(DGA(2),U,16)=1:"YES",1:"NO")
... D CHKL Q:DGQUIT
... W ! D CHKL Q:DGQUIT
QUIT K DIRUT,DTOUT D CLOSE^DGUTQ Q
;
HEAD S DGPG=DGPG+1 W @IOF,?(IOM-($L(DGDT)+7+$L(DGPG))),DGDT," PAGE ",DGPG,!
W ?(IOM-$L(HDR)/2),HDR,!
S DGT=$S(DGBEG=DGEND:"FOR ",1:"FROM ") S DGT=DGT_$$FMTE^XLFDT(DGBEG,"1D") I DGEND'=DGBEG S DGT=DGT_" TO "_$$FMTE^XLFDT(DGEND,"1D")
W ?(IOM-$L(DGT)/2),DGT
I $D(HDR2) W !?(IOM-$L(HDR2)/2),HDR2
W !,$TR($J("",IOM-$X)," ","*") Q
CHKL S DGQUIT=0 I $Y>(IOSL-4) D RET:(IOST?1"C-".E) Q:DGQUIT D HEAD
Q
RET K DIR S DIR(0)="E" D ^DIR K DIR(0) I $D(DIRUT) S DGQUIT=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRPECE2 6021 printed Sep 23, 2025@20:32:13 Page 2
DGRPECE2 ;ALB/MRY - REGISTRATION CATASTROPHIC EDITS REPORT ; 11/16/04 9:00am
+1 ;;5.3;Registration;**638,831**;Aug 13, 1993;Build 10
+2 ;
+3 NEW DIR,DGFMT,DGFMTD
FMT KILL DIR
SET DIR("A")="Select report format"
SET DIR(0)="S^D:DETAILED;S:SUMMARY"
+1 SET DIR("?",1)="DETAILED format allows the selected listing of all processed alerts, alerts"
+2 SET DIR("?",2)="not reviewed, or alerts determined to be catastrophic alerts. SUMMARY format"
+3 SET DIR("?",3)="allows the cumulative totals of processed alerts, alerts reviewed, and alerts"
+4 SET DIR("?")="determined to be catastrophic edits."
+5 SET DIR("B")="SUMMARY"
DO ^DIR
if $DATA(DIRUT)
QUIT
+6 SET DGFMT=Y
SET DGFMTD=""
+7 IF DGFMT="D"
Begin DoDot:1
+8 KILL DIR
SET DIR("A")="Select detailed category"
SET DIR(0)="S^1:ALL;2:NOT REVIEWED;3:CATASTROPHIC EDIT ONLY"
+9 SET DIR("?",1)="ALL category will display all alerts in unreviewed, reviewed catastrophic."
+10 SET DIR("?",2)="NOT REVIEWED will display all alerts that have not been reviewed."
+11 SET DIR("?",3)="CATASTROPHIC EDIT ONLY category will display those alerts that were deemed"
+12 SET DIR("?",4)="to be a catastrophic edit."
+13 SET DIR("B")="ALL"
DO ^DIR
+14 SET DGFMTD=Y
End DoDot:1
+15 ;
FDT WRITE !!,"***CATASTROPHIC EDIT ALERTS ARE ONLY RETAINED FOR 365 DAYS.***"
FDT1 SET %DT="AEPX"
SET %DT("A")="Beginning Date: "
DO ^%DT
IF X=U!($DATA(DTOUT))
QUIT
+1 if Y<1
GOTO FDT1
SET DGS1=Y
XECUTE ^DD("DD")
SET DGBEG=DGS1_U_Y
LDT WRITE !
SET %DT("A")=" Ending Date: "
DO ^%DT
IF X=U!($DATA(DTOUT))
QUIT
+1 IF Y<$PIECE(DGBEG,U)
WRITE !!,$CHAR(7),"Ending date must be after beginning date!"
GOTO LDT
+2 SET DGS1=Y
XECUTE ^DD("DD")
SET DGEND=DGS1_U_Y
+3 SET DGTAG=$SELECT(DGFMT="S":"SUMMARY",1:"DETAIL")
+4 SET DGVAR="DGBEG^DGEND^DGFMT^DGFMTD"
SET DGPGM="START^DGRPECE2"
WRITE !
DO ZIS^DGUTQ
IF 'POP
USE IO
GOTO START^DGRPECE2
+5 KILL %DT,DGBEG,DGEND,DGVAR,DGPGM,DGTAG,DGFMT,DGS1,DGFMTD,DIR,POP,X,Y
DO CLOSE^DGUTQ
QUIT
+6 ;
START ;
+1 NEW DGICN,DGADT,DGIEN,DGDT,HDR,HDR2,HDRS,DGSDT,DGEDT,DGTA,DGTR,DGTC,DGPG,DGDATA,DIR,DGT,DGQUIT,XQAID,DGA
+2 DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
SET DGDT=$$FMTE^XLFDT(Y,1)
+3 SET HDR="POTENTIAL CATASTROPHIC EDIT OF PATIENT IDENTIFYING DATA"
+4 IF DGFMT="S"
SET HDR=HDR_" SUMMARY REPORT"
+5 IF DGFMT="D"
SET HDR=HDR_" DETAILED REPORT"
+6 IF DGFMT="D"
SET HDR2="(Category: "_$SELECT(DGFMTD=1:"ALL",DGFMTD=2:"NOT REVIEWED",DGFMTD=3:"CATASTROPHIC EDITS",1:"")_")"
+7 ;
+8 SET DGSDT=+DGBEG-.0001
SET DGEDT=+DGEND_.9999
+9 SET (DGTA,DGTR,DGTC,DGPG)=0
KILL ^TMP($JOB,"DGRPECE")
+10 FOR
SET DGSDT=$ORDER(^XTV(8992.1,"D",DGSDT))
if 'DGSDT!(DGSDT>DGEDT)
QUIT
SET DGIEN=0
FOR
SET DGIEN=$ORDER(^(DGSDT,DGIEN))
if 'DGIEN
QUIT
Begin DoDot:1
+11 IF $$GET1^DIQ(8992.1,+DGIEN_",",1.04)'="DGRPECE1"
QUIT
+12 SET DGTA=DGTA+1
+13 SET DGDATA=$$GET1^DIQ(8992.1,+DGIEN_",",2)
+14 SET DGTR=DGTR+$SELECT($PIECE(DGDATA,U,15)'="":1,1:0)
+15 SET DGTC=DGTC+$SELECT($PIECE(DGDATA,U,16)=1:1,1:0)
+16 SET DGICN=$$GETICN^MPIF001($PIECE($PIECE(DGDATA,U,12),";"))
+17 IF DGFMTD=1
Begin DoDot:2
+18 SET ^TMP($JOB,"DGRPECE",DGICN,DGSDT,+DGIEN)=""
End DoDot:2
+19 IF DGFMTD=2
IF $PIECE(DGDATA,U,15)=""
Begin DoDot:2
+20 SET ^TMP($JOB,"DGRPECE",DGICN,DGSDT,+DGIEN)=""
End DoDot:2
+21 IF DGFMTD=3
IF $PIECE(DGDATA,U,16)=1
Begin DoDot:2
+22 SET ^TMP($JOB,"DGRPECE",DGICN,DGSDT,+DGIEN)=""
End DoDot:2
End DoDot:1
+23 ;
+24 DO HEAD
SUMMARY ;print summary
+1 WRITE !!,"TOTAL 'POTENTIAL CATASTROPHIC EDIT' ALERTS POSTED: ",DGTA
+2 WRITE !,"TOTAL 'POTENTIAL CATASTROPHIC EDIT' ALERTS REVIEWED: ",DGTR
+3 WRITE !,"TOTAL 'POTENTIAL CATASTROPHIC EDIT' ALERTS DETERMINED TO BE CATASTROPHIC: ",DGTC
+4 IF $ORDER(^TMP($JOB,"DGRPECE",""))=""!(DGFMT="S")
Begin DoDot:1
+5 KILL DIR
IF IOST?1"C-".E
SET DIR(0)="E"
DO ^DIR
KILL DIR(0)
End DoDot:1
GOTO QUIT
+6 ;
DETAIL ;Print detail
+1 WRITE !!,$TRANSLATE($JUSTIFY("",IOM)," ","*")
+2 SET HDRS="***** <POTENTIAL CATASTROPHIC EDIT OF IDENTIFYING DATA> *****"
+3 WRITE !?(IOM-$LENGTH(HDRS)/2),HDRS,!
+4 SET DGICN=0
FOR
SET DGICN=$ORDER(^TMP($JOB,"DGRPECE",DGICN))
if DGICN=""
QUIT
Begin DoDot:1
+5 SET DGADT=0
FOR
SET DGADT=$ORDER(^TMP($JOB,"DGRPECE",DGICN,DGADT))
if 'DGADT
QUIT
Begin DoDot:2
+6 SET DGIEN=0
FOR
SET DGIEN=$ORDER(^TMP($JOB,"DGRPECE",DGICN,DGADT,DGIEN))
if 'DGIEN
QUIT
Begin DoDot:3
+7 SET XQAID=$$GET1^DIQ(8992.1,+DGIEN_",",.01)
+8 DO ALERTDAT^XQALBUTL(XQAID,"DGA")
+9 WRITE !
DO CHKL
if DGQUIT
QUIT
+10 WRITE !,"Patient: "_$PIECE($PIECE(DGA(2),U,8),";")_" (ICN: "_DGICN_")",?60,"Station: ",$PIECE(DGA(2),U,13)
DO CHKL
if DGQUIT
QUIT
+11 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","-")
DO CHKL
if DGQUIT
QUIT
+12 WRITE !?3,"Patient Identification (before edit)"
DO CHKL
if DGQUIT
QUIT
+13 WRITE !?4,"Name: ",$PIECE(DGA(2),U),?45,"Soc. Security Number: ",$PIECE(DGA(2),U,2)
DO CHKL
if DGQUIT
QUIT
+14 WRITE !?4,"Date of Birth: ",$$DATE4^DGRPECE1($PIECE(DGA(2),U,3)),?45,"Gender: ",$SELECT($PIECE(DGA(2),U,4)="M":"MALE",$PIECE(DGA(2),U,4)="F":"FEMALE",1:$PIECE(DGA(2),U,4))
DO CHKL
if DGQUIT
QUIT
+15 WRITE !?4,"Mother's Maiden Name: ",$PIECE(DGA(2),U,5)
DO CHKL
if DGQUIT
QUIT
+16 WRITE !?4,"Place of Birth [city]: ",$PIECE(DGA(2),U,6)
DO CHKL
if DGQUIT
QUIT
+17 WRITE !?4,"Place of Birth [state]: "
IF $PIECE(DGA(2),U,7)
WRITE $PIECE(^DIC(5,$PIECE(DGA(2),U,7),0),U)
DO CHKL
if DGQUIT
QUIT
+18 WRITE !
DO CHKL
if DGQUIT
QUIT
+19 WRITE !?3,"Patient Identification fields (after edit)"
DO CHKL
if DGQUIT
QUIT
+20 WRITE !?3
if $PIECE($PIECE(DGA(2),U,8),";",2)="*"
WRITE "*"
WRITE ?4,"Name: ",$PIECE($PIECE(DGA(2),U,8),";")
WRITE ?44
if $PIECE($PIECE(DGA(2),U,9),";",2)="*"
WRITE "*"
WRITE ?45,"Soc. Security Number: ",$PIECE($PIECE(DGA(2),U,9),";")
+21 DO CHKL
if DGQUIT
QUIT
+22 WRITE !?3
if $PIECE($PIECE(DGA(2),U,10),";",2)="*"
WRITE "*"
WRITE ?4,"Date of Birth: ",$$DATE4^DGRPECE1($PIECE($PIECE(DGA(2),U,10),";"))
+23 WRITE ?44
if $PIECE($PIECE(DGA(2),U,11),";",2)="*"
WRITE "*"
WRITE ?45,"Gender: ",$SELECT($PIECE($PIECE(DGA(2),U,11),";")="M":"MALE",$PIECE($PIECE(DGA(2),U,11),";")="F":"FEMALE",1:"")
+24 DO CHKL
if DGQUIT
QUIT
+25 WRITE !
DO CHKL
if DGQUIT
QUIT
+26 WRITE !?3,"Edited by: ",$PIECE(DGA(.05),U,2),?45,"Generated: ",$PIECE(DGA(.02),U,2)
DO CHKL
if DGQUIT
QUIT
+27 WRITE !?3,"With Option: ",$$GET1^DIQ(19,+$PIECE(DGA(2),U,14)_",",.01)
DO CHKL
if DGQUIT
QUIT
+28 WRITE !?3,"Reviewed by: "
if $PIECE(DGA(2),U,15)
WRITE $PIECE(^VA(200,$PIECE(DGA(2),U,15),0),U)
+29 if $PIECE(DGA(2),U,15)
WRITE ?45,"Catastrophic Edit: ",$SELECT($PIECE(DGA(2),U,16)=1:"YES",1:"NO")
+30 DO CHKL
if DGQUIT
QUIT
+31 WRITE !
DO CHKL
if DGQUIT
QUIT
End DoDot:3
if DGQUIT
QUIT
End DoDot:2
if DGQUIT
QUIT
End DoDot:1
if DGQUIT
QUIT
QUIT KILL DIRUT,DTOUT
DO CLOSE^DGUTQ
QUIT
+1 ;
HEAD SET DGPG=DGPG+1
WRITE @IOF,?(IOM-($LENGTH(DGDT)+7+$LENGTH(DGPG))),DGDT," PAGE ",DGPG,!
+1 WRITE ?(IOM-$LENGTH(HDR)/2),HDR,!
+2 SET DGT=$SELECT(DGBEG=DGEND:"FOR ",1:"FROM ")
SET DGT=DGT_$$FMTE^XLFDT(DGBEG,"1D")
IF DGEND'=DGBEG
SET DGT=DGT_" TO "_$$FMTE^XLFDT(DGEND,"1D")
+3 WRITE ?(IOM-$LENGTH(DGT)/2),DGT
+4 IF $DATA(HDR2)
WRITE !?(IOM-$LENGTH(HDR2)/2),HDR2
+5 WRITE !,$TRANSLATE($JUSTIFY("",IOM-$X)," ","*")
QUIT
CHKL SET DGQUIT=0
IF $Y>(IOSL-4)
if (IOST?1"C-".E)
DO RET
if DGQUIT
QUIT
DO HEAD
+1 QUIT
RET KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR(0)
IF $DATA(DIRUT)
SET DGQUIT=1
+1 QUIT
