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

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

initial load of WorldVistAEHR
File size: 6.1 KB
RevLine 
[613]1DGRPECE1 ;ALB/MRY - REGISTRATION CATASTROPHIC EDITS ALERT ; 11/17/04 9:30am
2 ;;5.3;Registration;**638**;Aug 13, 1993
3 ;
4ALERT ;setup alert, display
5 K XQA,XQAMSG,XQAROU,XQAARCH,XQAID,XQADATA
6 N DGSITE,DGDUZ,CNT,DGI
7 ;XQA builds alert array. XMY builds mailgroup array (if needed).
8 S DGDUZ=0 F S DGDUZ=$O(^XUSEC("DG CATASTROPHIC EDIT",DGDUZ)) Q:'DGDUZ S XQA(DGDUZ)=""
9 I $O(XQA(""))="" D
10 . S DGDUZ=0 F S DGDUZ=$O(^XUSEC("DG SUPERVISOR",DGDUZ)) Q:'DGDUZ S XQA(DGDUZ)="",XMY(DGDUZ)=""
11 . S XMY("G.MPIF EXCEPTIONS")=""
12 . D MSG
13 I $O(XQA(""))="" Q ;hard too believe no supervisors.
14 S XQAMSG="POTENTIAL CATASTROPHIC EDIT OF PATIENT IDENTIFYING DATA"
15 ;see below for XQADATA values
16 S CNT=0 F DGI="NAME","SSN","DOB","SEX","MAIDEN","POBCITY","POBSTATE" S CNT=CNT+1 I $D(BEFORE(DGI)) S $P(XQADATA,U,CNT)=BEFORE(DGI)
17 S CNT=7 F DGI="NAME","SSN","DOB","SEX" S CNT=CNT+1 I $D(BUFFER(DGI)) S $P(XQADATA,U,CNT)=BUFFER(DGI) I $D(SAVE(DGI)) S $P(XQADATA,U,CNT)=$P(XQADATA,U,CNT)_";*"
18 S $P(XQADATA,U,12)=IEN,DGSITE=$$SITE^VASITE(),DGSITE=$P(DGSITE,U,3)
19 S $P(XQADATA,U,13)=DGSITE,$P(XQADATA,U,14)=XQY ;XQY = users current option (pointer)
20 S XQAROU="DISP^DGRPECE1",XQAARCH=365
21 S XQAID="DG,"_IEN
22 D SETUP^XQALERT Q
23 ;
24DISP ;display catastrophic alert information
25 N DGNAME,DGIEN,DGDATA,Y,HDR,HDR1,HDR2,DGRFLG
26 K XQAKILL ; Keep alert, unless removed (XQAKILL=1 below)
27 S DGIEN=$O(^XTV(8992.1,"B",XQAID,""))
28 W @IOF ;W !!,$TR($J("",IOM)," ","=")
29 S HDR=" <POTENTIAL CATASTROPHIC EDIT OF PATIENT IDENTIFYING DATA> "
30 S HDR1=$TR($J("",(IOM/2-($L(HDR)/2)))," ","=")_HDR,HDR2=HDR1_$TR($J("",(IOM-$L(HDR1)))," ","=")
31 W !,HDR2 ;W !,?(IOM-$L(HDR)/2),HDR
32 S DGNAME=$P($P(XQADATA,U,8),";")
33 W !,"Patient: ",DGNAME_" (ICN:"_$$GETICN^MPIF001($P(XQADATA,U,12))_")",?60,"Station: ",$P(XQADATA,U,13)
34 W !,$TR($J("",IOM)," ","-")
35 W !,"Patient Identification fields (before edit)"
36 W !,$TR($J("",IOM)," ","-")
37 W !?1,"Name: ",$P(XQADATA,U),?45,"Soc. Security Number: ",$P(XQADATA,U,2)
38 W !?1,"Date of Birth: ",$$DATE4($P(XQADATA,U,3)),?45,"Gender: ",$S($P(XQADATA,U,4)="M":"MALE",$P(XQADATA,U,4)="F":"FEMALE",1:"")
39 W !?1,"Mother's Maiden Name: ",$P(XQADATA,U,5)
40 W !?1,"Place of Birth [city]: ",$P(XQADATA,U,6)
41 W !?1,"Place of Birth [state]: " I $P(XQADATA,U,7) W $P(^DIC(5,$P(XQADATA,U,7),0),U)
42 W !,$TR($J("",IOM)," ","-")
43 W !,"Patient Identification fields (after edit)"
44 W !,$TR($J("",IOM)," ","-")
45 W ! W:$P($P(XQADATA,U,8),";",2)="*" "*" W ?1,"Name: ",$P($P(XQADATA,U,8),";") W ?44 W:$P($P(XQADATA,U,9),";",2)="*" "*" W ?45,"Soc. Security Number: ",$P($P(XQADATA,U,9),";")
46 W ! W:$P($P(XQADATA,U,10),";",2)="*" "*" W ?1,"Date of Birth: ",$$DATE4($P($P(XQADATA,U,10),";"))
47 W ?44 W:$P($P(XQADATA,U,11),";",2)="*" "*" W ?45,"Gender: ",$S($P($P(XQADATA,U,11),";")="M":"MALE",$P($P(XQADATA,U,11),";")="F":"FEMALE",1:"")
48 W !,$TR($J("",IOM)," ","-")
49 S DGDATA=$$GET1^DIQ(8992.1,+DGIEN_",",.02)
50 W !,"Edited by: ",$$GET1^DIQ(8992.1,+DGIEN_",",.05),?45,"Generated: ",$$FMTE^XLFDT(DGDATA,"2P")
51 S DGDATA=$P(XQADATA,U,14),DGDATA=$$GET1^DIQ(19,+DGDATA_",",.01) ;option name
52 W !,"With Option: ",DGDATA
53 ;W !,$TR($J("",IOM)," ","-")
54 S DGDATA=$$GET1^DIQ(8992.1,+DGIEN_",",2)
55 W !,"Reviewed by: " W:$P(DGDATA,U,15) $P(^VA(200,$P(DGDATA,U,15),0),U)
56 W:$P(DGDATA,U,15) ?45,"Catastrophic Edit: ",$S($P(DGDATA,U,16)=1:"YES",1:"NO")
57 W !,$TR($J("",IOM)," ","-")
58 ;CE reviewed?
59 S DGRFLG=0 ;Review flag determine delete prompting
60 I $P(DGDATA,U,15)="" D REVIEW S DGRFLG=1
61 ;If CE reviewed, can the alert be removed?
62 I $P(DGDATA,U,15) D REMOVE
63 K XQAKILL
64 Q
65 ;
66REVIEW ;
67 N DGANS,DIR,DGCE
68 S DIR(0)="Y",DIR("A")="IS REVIEW COMPLETE"
69 S DIR("B")="NO" D ^DIR K DIR S DGANS=Y
70 I DGANS=1 D
71 . S DIR(0)="Y",DIR("A")="IS THIS ALERT DETERMINED TO BE A CATASTROPHIC EDIT"
72 . S DIR("B")="NO" D ^DIR K DIR S DGCE=Y
73 . N FDA
74 . S $P(DGDATA,U,15)=DUZ
75 . S $P(DGDATA,U,16)=DGCE
76 . S FDA(8992.1,+DGIEN_",",2)=DGDATA
77 . D FILE^DIE("","FDA","DIERR")
78 Q
79REMOVE ;
80 N Y,DIR
81 S DIR(0)="Y"
82 S:DGRFLG=1 DIR("A")="DO YOU WANT TO DELETE ALERT"
83 S:DGRFLG=0 DIR("A")="THIS ALERT HAS BEEN REVIEWED, DO YOU WANT TO DELETE THE ALERT"
84 S DIR("B")="NO" D ^DIR K DIR
85 I Y=1 S XQAKILL=1 D DELETE^XQALERT ;keep renewed, unless reviewed
86 Q
87MSG ;
88 K ^TMP($J,"DGRPECE")
89 S XMDUZ=.5,XMSUB="POTENTIAL CATASTROPHIC EDIT ALERT SETUP"
90 S ^TMP($J,"DGRPECE",1,0)="ATTENTION ADT SUPERVISORS:"
91 S ^TMP($J,"DGRPECE",2,0)=" "
92 S ^TMP($J,"DGRPECE",3,0)="You are receiving this message along with a potential catastrophic edit alert"
93 S ^TMP($J,"DGRPECE",4,0)="because there are no users holding the DG CATASTROPHIC EDIT key."
94 S ^TMP($J,"DGRPECE",5,0)=" "
95 S ^TMP($J,"DGRPECE",6,0)="Please see that an appropriate Supervisor and ADPAC are given this key."
96 S ^TMP($J,"DGRPECE",7,0)="Documentation on these catastrophic edits can be found in patch DG*5.3*638."
97 S ^TMP($J,"DGRPECE",8,0)=" "
98 S ^TMP($J,"DGRPECE",9,0)="This message has been forwarded to the National Data Quality mailgroup."
99 S ^TMP($J,"DGRPECE",10,0)="Station name: "_$P($$SITE^VASITE(),U,2)_" ("_$P($$SITE^VASITE(),U)_")"
100 S XMTEXT="^TMP("_$J_",""DGRPECE""," D ^XMD S DA=XMZ,DIE=3.9,DR="1.7///P;1.97///Y" D ^DIE
101 K ^TMP($J,"DGRPECE"),DIE,DA,DR,XMY,XMDUZ,XMSUB,XMTEXT,XMZ Q
102DATE4(X) ;return date in DD/MM/YYYY format
103 S:X X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_(1700+$E(X,1,3))
104 Q X
105 ;
106XQADATA ;XQADATA =
107 ;1=before snapshot name^ (31 chars = 30 chars+'^')
108 ;2=before snapshot ssn^ (11)
109 ;3=before snapshot dob^ ( 8)
110 ;4=before snapshot sex^ ( 2)
111 ;5=before snapshot mother's maiden name^ (18)
112 ;6=before snapshot pob city^ (16)
113 ;7=before snapshot pob state^ ( 3) a guess, its a pointer
114 ;8=after snapshot name^ (31)
115 ;9=after snapshot ssn^ (11)
116 ;10=after snapshot dob^ ( 8)
117 ;11=after snapshot sex^ ( 2)
118 ;12=patient ien^ (11) a guess, its a pointer
119 ;13=station#^ ( 6) a guess, its a pointer
120 ;14=user menu pointer^ ( 5) a guess, its a pointer
121 ;15=reviewer duz^ (11) a guess, its a pointer
122 ;16=CE edit (y/n) ( 2)
123 ; total = 176 chars.
Note: See TracBrowser for help on using the repository browser.