source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRPECE2.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.8 KB
RevLine 
[613]1DGRPECE2 ;ALB/MRY - REGISTRATION CATASTROPHIC EDITS REPORT ; 11/16/04 9:00am
2 ;;5.3;Registration;**638**;Aug 13, 1993
3 ;
4 N DIR,DGFMT,DGFMTD
5FMT K DIR S DIR("A")="Select report format",DIR(0)="S^D:DETAILED;S:SUMMARY"
6 S DIR("?",1)="DETAILED format allows the selected listing of all processed alerts, alerts"
7 S DIR("?",2)="not reviewed, or alerts determined to be catastrophic alerts. SUMMARY format"
8 S DIR("?",3)="allows the cummulative totals of processed alerts, alerts reviewed, and alerts"
9 S DIR("?")="determined to be catastrophic edits."
10 S DIR("B")="SUMMARY" D ^DIR Q:$D(DIRUT)
11 S DGFMT=Y,DGFMTD=""
12 I DGFMT="D" D
13 . K DIR S DIR("A")="Select detailed category",DIR(0)="S^1:ALL;2:NOT REVIEWED;3:CATASTROPHIC EDIT ONLY"
14 . S DIR("?",1)="ALL category will display all alerts in unreviewed, reviewed catastrophic."
15 . S DIR("?",2)="NOT REVIEWED will display all alerts that have not been reviewed."
16 . S DIR("?",3)="CATASTROPHIC EDIT ONLY category will display those alerts that were deemed"
17 . S DIR("?",4)="to be a catastrophic edit."
18 . S DIR("B")="ALL" D ^DIR
19 . S DGFMTD=Y
20 ;
21FDT W !!,"***CATASTROPHIC EDIT ALERTS ARE ONLY RETAINED FOR 365 DAYS.***"
22FDT1 S %DT="AEPX",%DT("A")="Beginning Date: " D ^%DT I X=U!($D(DTOUT)) Q
23 G:Y<1 FDT1 S DGS1=Y X ^DD("DD") S DGBEG=DGS1_U_Y
24LDT W ! S %DT("A")=" Ending Date: " D ^%DT I X=U!($D(DTOUT)) Q
25 I Y<$P(DGBEG,U) W !!,$C(7),"Ending date must be after beginning date!" G LDT
26 S DGS1=Y X ^DD("DD") S DGEND=DGS1_U_Y
27 S DGTAG=$S(DGFMT="S":"SUMMARY",1:"DETAIL")
28 S DGVAR="DGBEG^DGEND^DGFMT^DGFMTD",DGPGM="START^DGRPECE2" W ! D ZIS^DGUTQ I 'POP U IO G START^DGRPECE2
29 K %DT,DGBEG,DGEND,DGVAR,DGPGM,DGTAG,DGFMT,DGS1,DGFMTD,DIR,POP,X,Y D CLOSE^DGUTQ Q
30 ;
31START ;
32 N DGICN,DGADT,DGIEN,DGDT,HDR,HDR2,HDRS,DGSDT,DGEDT,DGTA,DGTR,DGTC,DGPG,DGDATA,DIR,DGT,DGQUIT,XQAID,DGA
33 D NOW^%DTC S Y=$E(%,1,12) S DGDT=$$FMTE^XLFDT(Y,1)
34 S HDR="POTENTIAL CATASTROPHIC EDIT OF PATIENT IDENTIFYING DATA"
35 I DGFMT="S" S HDR=HDR_" SUMMARY REPORT"
36 I DGFMT="D" S HDR=HDR_" DETAILED REPORT"
37 I DGFMT="D" S HDR2="(Category: "_$S(DGFMTD=1:"ALL",DGFMTD=2:"NOT REVIEWED",DGFMTD=3:"CATASTROPHIC EDITS",1:"")_")"
38 ;
39 S DGSDT=+DGBEG-.0001,DGEDT=+DGEND_.9999
40 S (DGTA,DGTR,DGTC,DGPG)=0 K ^TMP($J,"DGRPECE")
41 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
42 . I $$GET1^DIQ(8992.1,+DGIEN_",",1.04)'="DGRPECE1" Q
43 . S DGTA=DGTA+1
44 . S DGDATA=$$GET1^DIQ(8992.1,+DGIEN_",",2)
45 . S DGTR=DGTR+$S($P(DGDATA,U,15)'="":1,1:0)
46 . S DGTC=DGTC+$S($P(DGDATA,U,16)=1:1,1:0)
47 . S DGICN=$$GETICN^MPIF001($P($P(DGDATA,U,12),";"))
48 . I DGFMTD=1 D
49 .. S ^TMP($J,"DGRPECE",DGICN,DGSDT,+DGIEN)=""
50 . I DGFMTD=2,$P(DGDATA,U,15)="" D
51 .. S ^TMP($J,"DGRPECE",DGICN,DGSDT,+DGIEN)=""
52 . I DGFMTD=3,$P(DGDATA,U,16)=1 D
53 .. S ^TMP($J,"DGRPECE",DGICN,DGSDT,+DGIEN)=""
54 ;
55 D HEAD
56SUMMARY ;print summary
57 W !!,"TOTAL 'POTENTIAL CATASTROPHIC EDIT' ALERTS POSTED: ",DGTA
58 W !,"TOTAL 'POTENTIAL CATASTROPHIC EDIT' ALERTS REVIEWED: ",DGTR
59 W !,"TOTAL 'POTENTIAL CATASTROPHIC EDIT' ALERTS DETERMINED TO BE CATASTROPHIC: ",DGTC
60 I $O(^TMP($J,"DGRPECE",""))=""!(DGFMT="S") D G QUIT
61 . K DIR I IOST?1"C-".E S DIR(0)="E" D ^DIR K DIR(0)
62 ;
63DETAIL ;Print detail
64 W !!,$TR($J("",IOM)," ","*")
65 S HDRS="***** <POTENTIAL CATASTROPHIC EDIT OF IDENTIFYING DATA> *****"
66 W !?(IOM-$L(HDRS)/2),HDRS,!
67 S DGICN=0 F S DGICN=$O(^TMP($J,"DGRPECE",DGICN)) Q:DGICN="" D Q:DGQUIT
68 . S DGADT=0 F S DGADT=$O(^TMP($J,"DGRPECE",DGICN,DGADT)) Q:'DGADT D Q:DGQUIT
69 .. S DGIEN=0 F S DGIEN=$O(^TMP($J,"DGRPECE",DGICN,DGADT,DGIEN)) Q:'DGIEN D Q:DGQUIT
70 ... S XQAID=$$GET1^DIQ(8992.1,+DGIEN_",",.01)
71 ... D ALERTDAT^XQALBUTL(XQAID,"DGA")
72 ... W ! D CHKL Q:DGQUIT
73 ... W !,"Patient: "_$P($P(DGA(2),U,8),";")_" (ICN: "_DGICN_")",?60,"Station: ",$P(DGA(2),U,13) D CHKL Q:DGQUIT
74 ... W !,$TR($J("",IOM)," ","-") D CHKL Q:DGQUIT
75 ... W !?3,"Patient Identification (before edit)" D CHKL Q:DGQUIT
76 ... W !?4,"Name: ",$P(DGA(2),U),?45,"Soc. Security Number: ",$P(DGA(2),U,2) D CHKL Q:DGQUIT
77 ... 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:"") D CHKL Q:DGQUIT
78 ... W !?4,"Mother's Maiden Name: ",$P(DGA(2),U,5) D CHKL Q:DGQUIT
79 ... W !?4,"Place of Birth [city]: ",$P(DGA(2),U,6) D CHKL Q:DGQUIT
80 ... 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
81 ... W ! D CHKL Q:DGQUIT
82 ... W !?3,"Patient Identification fields (after edit)" D CHKL Q:DGQUIT
83 ... 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),";")
84 ... D CHKL Q:DGQUIT
85 ... W !?3 W:$P($P(DGA(2),U,10),";",2)="*" "*" W ?4,"Date of Birth: ",$$DATE4^DGRPECE1($P($P(DGA(2),U,10),";"))
86 ... 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:"")
87 ... D CHKL Q:DGQUIT
88 ... W ! D CHKL Q:DGQUIT
89 ... W !?3,"Edited by: ",$P(DGA(.05),U,2),?45,"Generated: ",$P(DGA(.02),U,2) D CHKL Q:DGQUIT
90 ... W !?3,"With Option: ",$$GET1^DIQ(19,+$P(DGA(2),U,14)_",",.01) D CHKL Q:DGQUIT
91 ... W !?3,"Reviewed by: " W:$P(DGA(2),U,15) $P(^VA(200,$P(DGA(2),U,15),0),U)
92 ... W:$P(DGA(2),U,15) ?45,"Catastrophic Edit: ",$S($P(DGA(2),U,16)=1:"YES",1:"NO")
93 ... D CHKL Q:DGQUIT
94 ... W ! D CHKL Q:DGQUIT
95QUIT K DIRUT,DTOUT D CLOSE^DGUTQ Q
96 ;
97HEAD S DGPG=DGPG+1 W @IOF,?(IOM-($L(DGDT)+7+$L(DGPG))),DGDT," PAGE ",DGPG,!
98 W ?(IOM-$L(HDR)/2),HDR,!
99 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")
100 W ?(IOM-$L(DGT)/2),DGT
101 I $D(HDR2) W !?(IOM-$L(HDR2)/2),HDR2
102 W !,$TR($J("",IOM-$X)," ","*") Q
103CHKL S DGQUIT=0 I $Y>(IOSL-4) D RET:(IOST?1"C-".E) Q:DGQUIT D HEAD
104 Q
105RET K DIR S DIR(0)="E" D ^DIR K DIR(0) I $D(DIRUT) S DGQUIT=1
106 Q
Note: See TracBrowser for help on using the repository browser.