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

DGRPECE1.m

Go to the documentation of this file. 
  1. DGRPECE1 ;ALB/MRY - REGISTRATION CATASTROPHIC EDITS ALERT ; 11/17/04 9:30am
  1.  ;;5.3;PIMS;**638,1015,1016**;JUN 30, 2012;Build 20
  1.  ;
  1. ALERT ;setup alert, display
  1.  K XQA,XQAMSG,XQAROU,XQAARCH,XQAID,XQADATA
  1.  N DGSITE,DGDUZ,CNT,DGI
  1.  ;XQA builds alert array.  XMY builds mailgroup array (if needed).
  1.  S DGDUZ=0 F  S DGDUZ=$O(^XUSEC("DG CATASTROPHIC EDIT",DGDUZ)) Q:'DGDUZ  S XQA(DGDUZ)=""
  1.  I $O(XQA(""))="" D
  1.  . S DGDUZ=0 F  S DGDUZ=$O(^XUSEC("DG SUPERVISOR",DGDUZ)) Q:'DGDUZ  S XQA(DGDUZ)="",XMY(DGDUZ)=""
  1.  . S XMY("G.MPIF EXCEPTIONS")=""
  1.  . D MSG
  1.  I $O(XQA(""))="" Q  ;hard to believe no supervisors.
  1.  S XQAMSG="POTENTIAL CATASTROPHIC EDIT OF PATIENT IDENTIFYING DATA"
  1.  ;see below for XQADATA values
  1.  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)
  1.  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)_";*"
  1.  S $P(XQADATA,U,12)=IEN,DGSITE=$$SITE^VASITE(),DGSITE=$P(DGSITE,U,3)
  1.  S $P(XQADATA,U,13)=DGSITE,$P(XQADATA,U,14)=XQY ;XQY = users current option (pointer)
  1.  S XQAROU="DISP^DGRPECE1",XQAARCH=365
  1.  S XQAID="DG,"_IEN
  1.  D SETUP^XQALERT Q
  1.  ;
  1. DISP ;display catastrophic alert information
  1.  N DGNAME,DGIEN,DGDATA,Y,HDR,HDR1,HDR2,DGRFLG
  1.  K XQAKILL ; Keep alert, unless removed (XQAKILL=1 below)
  1.  S DGIEN=$O(^XTV(8992.1,"B",XQAID,""))
  1.  W @IOF ;W !!,$TR($J("",IOM)," ","=")
  1.  S HDR=" <POTENTIAL CATASTROPHIC EDIT OF PATIENT IDENTIFYING DATA> "
  1.  S HDR1=$TR($J("",(IOM/2-($L(HDR)/2)))," ","=")_HDR,HDR2=HDR1_$TR($J("",(IOM-$L(HDR1)))," ","=")
  1.  W !,HDR2 ;W !,?(IOM-$L(HDR)/2),HDR
  1.  S DGNAME=$P($P(XQADATA,U,8),";")
  1.  W !,"Patient: ",DGNAME_" (ICN:"_$$GETICN^MPIF001($P(XQADATA,U,12))_")",?60,"Station: ",$P(XQADATA,U,13)
  1.  W !,$TR($J("",IOM)," ","-")
  1.  W !,"Patient Identification fields (before edit)"
  1.  W !,$TR($J("",IOM)," ","-")
  1.  W !?1,"Name: ",$P(XQADATA,U),?45,"Soc. Security Number: ",$P(XQADATA,U,2)
  1.  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:$P(XQADATA,U,4))
  1.  W !?1,"Mother's Maiden Name: ",$P(XQADATA,U,5)
  1.  W !?1,"Place of Birth [city]: ",$P(XQADATA,U,6)
  1.  W !?1,"Place of Birth [state]: " I $P(XQADATA,U,7) W $P(^DIC(5,$P(XQADATA,U,7),0),U)
  1.  W !,$TR($J("",IOM)," ","-")
  1.  W !,"Patient Identification fields (after edit)"
  1.  W !,$TR($J("",IOM)," ","-")
  1.  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),";")
  1.  W ! W:$P($P(XQADATA,U,10),";",2)="*" "*" W ?1,"Date of Birth: ",$$DATE4($P($P(XQADATA,U,10),";"))
  1.  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:"")
  1.  W !,$TR($J("",IOM)," ","-")
  1.  S DGDATA=$$GET1^DIQ(8992.1,+DGIEN_",",.02)
  1.  W !,"Edited by:   ",$$GET1^DIQ(8992.1,+DGIEN_",",.05),?45,"Generated: ",$$FMTE^XLFDT(DGDATA,"2P")
  1.  S DGDATA=$P(XQADATA,U,14),DGDATA=$$GET1^DIQ(19,+DGDATA_",",.01) ;option name
  1.  W !,"With Option: ",DGDATA
  1.  ;W !,$TR($J("",IOM)," ","-")
  1.  S DGDATA=$$GET1^DIQ(8992.1,+DGIEN_",",2)
  1.  W !,"Reviewed by: " W:$P(DGDATA,U,15) $P(^VA(200,$P(DGDATA,U,15),0),U)
  1.  W:$P(DGDATA,U,15) ?45,"Catastrophic Edit: ",$S($P(DGDATA,U,16)=1:"YES",1:"NO")
  1.  W !,$TR($J("",IOM)," ","-")
  1.  ;CE reviewed?
  1.  S DGRFLG=0 ;Review flag determine delete prompting
  1.  I $P(DGDATA,U,15)="" D REVIEW S DGRFLG=1
  1.  ;If CE reviewed, can the alert be removed?
  1.  I $P(DGDATA,U,15) D REMOVE
  1.  K XQAKILL
  1.  Q
  1.  ;
  1. REVIEW ;
  1.  N DGANS,DIR,DGCE
  1.  S DIR(0)="Y",DIR("A")="IS REVIEW COMPLETE"
  1.  S DIR("B")="NO" D ^DIR K DIR S DGANS=Y
  1.  I DGANS=1 D
  1.  . S DIR(0)="Y",DIR("A")="IS THIS ALERT DETERMINED TO BE A CATASTROPHIC EDIT"
  1.  . S DIR("B")="NO" D ^DIR K DIR S DGCE=Y
  1.  . N FDA
  1.  . S $P(DGDATA,U,15)=DUZ
  1.  . S $P(DGDATA,U,16)=DGCE
  1.  . S FDA(8992.1,+DGIEN_",",2)=DGDATA
  1.  . D FILE^DIE("","FDA","DIERR")
  1.  Q
  1. REMOVE ;
  1.  N Y,DIR
  1.  S DIR(0)="Y"
  1.  S:DGRFLG=1 DIR("A")="DO YOU WANT TO DELETE ALERT"
  1.  S:DGRFLG=0 DIR("A")="THIS ALERT HAS BEEN REVIEWED, DO YOU WANT TO DELETE THE ALERT"
  1.  S DIR("B")="NO" D ^DIR K DIR
  1.  I Y=1 S XQAKILL=1 D DELETE^XQALERT ;keep renewed, unless reviewed
  1.  Q
  1. MSG ;
  1.  K ^TMP($J,"DGRPECE")
  1.  S XMDUZ=.5,XMSUB="POTENTIAL CATASTROPHIC EDIT ALERT SETUP"
  1.  S ^TMP($J,"DGRPECE",1,0)="ATTENTION ADT SUPERVISORS:"
  1.  S ^TMP($J,"DGRPECE",2,0)=" "
  1.  S ^TMP($J,"DGRPECE",3,0)="You are receiving this message along with a potential catastrophic edit alert"
  1.  S ^TMP($J,"DGRPECE",4,0)="because there are no users holding the DG CATASTROPHIC EDIT key."
  1.  S ^TMP($J,"DGRPECE",5,0)=" "
  1.  S ^TMP($J,"DGRPECE",6,0)="Please see that an appropriate Supervisor and ADPAC are given this key."
  1.  S ^TMP($J,"DGRPECE",7,0)="Documentation on these catastrophic edits can be found in patch DG*5.3*638."
  1.  S ^TMP($J,"DGRPECE",8,0)=" "
  1.  S ^TMP($J,"DGRPECE",9,0)="This message has been forwarded to the National Data Quality mailgroup."
  1.  S ^TMP($J,"DGRPECE",10,0)="Station name: "_$P($$SITE^VASITE(),U,2)_" ("_$P($$SITE^VASITE(),U)_")"
  1.  S XMTEXT="^TMP("_$J_",""DGRPECE""," D ^XMD S DA=XMZ,DIE=3.9,DR="1.7///P;1.97///Y" D ^DIE
  1.  K ^TMP($J,"DGRPECE"),DIE,DA,DR,XMY,XMDUZ,XMSUB,XMTEXT,XMZ Q
  1. DATE4(X) ;return date in DD/MM/YYYY format
  1.  I X'["/" D
  1.  .S:X X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_(1700+$E(X,1,3))
  1.  Q X
  1.  ;
  1. XQADATA ;XQADATA =
  1.  ;1=before snapshot name^                  (31 chars = 30 chars+'^')
  1.  ;2=before snapshot ssn^                   (11)
  1.  ;3=before snapshot dob^                   ( 8)
  1.  ;4=before snapshot sex^                   ( 2)
  1.  ;5=before snapshot mother's maiden name^  (18)
  1.  ;6=before snapshot pob city^              (16)
  1.  ;7=before snapshot pob state^             ( 3) a guess, its a pointer
  1.  ;8=after snapshot name^                   (31)
  1.  ;9=after snapshot ssn^                    (11)
  1.  ;10=after snapshot dob^                   ( 8)
  1.  ;11=after snapshot sex^                   ( 2)
  1.  ;12=patient ien^                          (11) a guess, its a pointer
  1.  ;13=station#^                             ( 6) a guess, its a pointer
  1.  ;14=user menu pointer^                    ( 5) a guess, its a pointer
  1.  ;15=reviewer duz^                         (11) a guess, its a pointer
  1.  ;16=CE edit (y/n)                         ( 2)
  1.  ;                                 total = 176 chars.