GMRA1003 ;IHS/MSC/PLS - Patch support;29-Aug-2011 18:20;PLS
;;4.0;Adverse Reaction Tracking;**1003**;Mar 29, 1996;Build 18
;
ENV ;EP -
Q
PRE ;EP -
Q
POST ;EP -
D DATA
Q
;
DATA ; Import Data
N LP,NAM,F,LNAARY
; Build array of local national allergies
S LP=0 F S LP=$O(^GMRD(120.82,LP)) Q:'LP D
.Q:'$P(^GMRD(120.82,LP,0),U,3) ;Must be a National Allergy
.S LNAARY($P(^GMRD(120.82,LP,0),U),LP)=""
S F=120.82
S LP=0 F S LP=$O(@XPDGREF@("DATA",F,LP)) Q:'LP D
.Q:'$P(@XPDGREF@("DATA",F,LP,0),U,3) ; Must be marked as National Allergy
.S NAM=$P($G(@XPDGREF@("DATA",F,LP,0)),U)
.D STOREALG(LP)
Q
;
STOREALG(DATAIEN) ;
N FDA,FDAIEN,ERR,IENS,ARY,LP2,CNT,IEN
Q:'$L(DATAIEN)
M ARY=@XPDGREF@("DATA",120.82,DATAIEN)
S IEN=$$ALGIEN(NAM)
S:'IEN IEN="+1"
S IENS=IEN_","
S CNT=0
I IEN D ;EXISTING ENTRY
.S FDA(F,IENS,1)=$P(ARY(0),U,2)
.S FDA(F,IENS,2)=$P(ARY(0),U,3)
.D FILE^DIE("K","FDA","ERR")
.Q:$D(ERR)
.D SUBDATA(IEN)
E D ;New entry
.S FDA(F,IENS,.01)=$P(ARY(0),U)
.S FDA(F,IENS,1)=$P(ARY(0),U,2)
.S FDA(F,IENS,2)=$P(ARY(0),U,3)
.D UPDATE^DIE("","FDA","IENS","ERR")
.I $D(ERR) W !,IENS W ERR W !! Q
.D SUBDATA(IENS(1))
; Add subfile data
SUBDATA(DIEN) ;EP-
N IENS
S IENS=DIEN_","
; KILL EXISTING SUBFILE DATA
;Synonyms
K ^GMRD(120.82,DIEN,3)
S LP2=0 F S LP2=$O(ARY(3,LP2)) Q:'LP2 D
.S FDA(120.823,"+"_$$INC()_","_IENS,.01)=$P(ARY(3,LP2,0),U)
;Drug Class
K ^GMRD(120.82,DIEN,"CLASS")
S LP2=0 F S LP2=$O(ARY("CLASS",LP2)) Q:'LP2 D
.S FDA(120.8205,"+"_$$INC()_","_IENS,.01)=$P(ARY("CLASS",LP2,0),U)
;Drug Ingredient
K ^GMRD(120.82,DIEN,"ING")
S LP2=0 F S LP2=$O(ARY("ING",LP2)) Q:'LP2 D
.S FDA(120.824,"+"_$$INC()_","_IENS,.01)=$P(ARY("ING",LP2,0),U)
;Effective Date
K ^GMRD(120.82,DIEN,"TERMSTATUS")
S LP2=0 F S LP2=$O(ARY("TERMSTATUS",LP2)) Q:'LP2 D
.S FDA(120.8299,"+"_$$INC()_","_IENS,.01)=$P(ARY("TERMSTATUS",LP2,0),U)
.S FDA(120.8299,"+"_$$INC(0)_","_IENS,.02)=$P(ARY("TERMSTATUS",LP2,0),U,2)
K ERR
D UPDATE^DIE("","FDA","","ERR")
I $D(ERR) W !,IENS W ERR W !! Q
Q
; Increment counter
INC(VAL) ;EP-
S VAL=$G(VAL,1)
S CNT=$G(CNT)+VAL
Q CNT
DIERR(XPDI) N XPD
D MSG^DIALOG("AE",.XPD) Q:'$D(XPD)
D BMES^XPDUTL(XPDI),MES^XPDUTL(.XPD)
Q
; Check existence of entry
EXISTS(NAM) ;EP -
Q $O(LNAARY(NAM,0))>0
; Get Allergy IEN from Local National Allergies
ALGIEN(NAM) ;EP-
Q $O(LNAARY(NAM,0))
; Check for Drug Allergy
DRUG(IEN) ;EP-
Q $P($G(^GMRD(120.82,IEN,0)),U,2)["D"
;
PRETRAN ;EP -
N FNAM,FILE
S FILE=120.82
S FNAM="GMR ALLERGIES"
D FIA^DIFROMSU(FILE,"",FNAM,XPDGREF,"n^n^f^^n^^y^m^n","","I $P(^(0),U,3)=1",4.0)
D DATAOUT^DIFROMS("","","",XPDGREF)
Q
GMRA1003 ;IHS/MSC/PLS - Patch support;29-Aug-2011 18:20;PLS
+1 ;;4.0;Adverse Reaction Tracking;**1003**;Mar 29, 1996;Build 18
+2 ;
ENV ;EP -
+1 QUIT
PRE ;EP -
+1 QUIT
POST ;EP -
+1 DO DATA
+2 QUIT
+3 ;
DATA ; Import Data
+1 NEW LP,NAM,F,LNAARY
+2 ; Build array of local national allergies
+3 SET LP=0
FOR
SET LP=$ORDER(^GMRD(120.82,LP))
IF 'LP
QUIT
Begin DoDot:1
+4 ;Must be a National Allergy
IF '$PIECE(^GMRD(120.82,LP,0),U,3)
QUIT
+5 SET LNAARY($PIECE(^GMRD(120.82,LP,0),U),LP)=""
End DoDot:1
+6 SET F=120.82
+7 SET LP=0
FOR
SET LP=$ORDER(@XPDGREF@("DATA",F,LP))
IF 'LP
QUIT
Begin DoDot:1
+8 ; Must be marked as National Allergy
IF '$PIECE(@XPDGREF@("DATA",F,LP,0),U,3)
QUIT
+9 SET NAM=$PIECE($GET(@XPDGREF@("DATA",F,LP,0)),U)
+10 DO STOREALG(LP)
End DoDot:1
+11 QUIT
+12 ;
STOREALG(DATAIEN) ;
+1 NEW FDA,FDAIEN,ERR,IENS,ARY,LP2,CNT,IEN
+2 IF '$LENGTH(DATAIEN)
QUIT
+3 MERGE ARY=@XPDGREF@("DATA",120.82,DATAIEN)
+4 SET IEN=$$ALGIEN(NAM)
+5 IF 'IEN
SET IEN="+1"
+6 SET IENS=IEN_","
+7 SET CNT=0
+8 ;EXISTING ENTRY
IF IEN
Begin DoDot:1
+9 SET FDA(F,IENS,1)=$PIECE(ARY(0),U,2)
+10 SET FDA(F,IENS,2)=$PIECE(ARY(0),U,3)
+11 DO FILE^DIE("K","FDA","ERR")
+12 IF $DATA(ERR)
QUIT
+13 DO SUBDATA(IEN)
End DoDot:1
+14 ;New entry
IF '$TEST
Begin DoDot:1
+15 SET FDA(F,IENS,.01)=$PIECE(ARY(0),U)
+16 SET FDA(F,IENS,1)=$PIECE(ARY(0),U,2)
+17 SET FDA(F,IENS,2)=$PIECE(ARY(0),U,3)
+18 DO UPDATE^DIE("","FDA","IENS","ERR")
+19 IF $DATA(ERR)
WRITE !,IENS
WRITE ERR
WRITE !!
QUIT
+20 DO SUBDATA(IENS(1))
End DoDot:1
+21 ; Add subfile data
SUBDATA(DIEN) ;EP-
+1 NEW IENS
+2 SET IENS=DIEN_","
+3 ; KILL EXISTING SUBFILE DATA
+4 ;Synonyms
+5 KILL ^GMRD(120.82,DIEN,3)
+6 SET LP2=0
FOR
SET LP2=$ORDER(ARY(3,LP2))
IF 'LP2
QUIT
Begin DoDot:1
+7 SET FDA(120.823,"+"_$$INC()_","_IENS,.01)=$PIECE(ARY(3,LP2,0),U)
End DoDot:1
+8 ;Drug Class
+9 KILL ^GMRD(120.82,DIEN,"CLASS")
+10 SET LP2=0
FOR
SET LP2=$ORDER(ARY("CLASS",LP2))
IF 'LP2
QUIT
Begin DoDot:1
+11 SET FDA(120.8205,"+"_$$INC()_","_IENS,.01)=$PIECE(ARY("CLASS",LP2,0),U)
End DoDot:1
+12 ;Drug Ingredient
+13 KILL ^GMRD(120.82,DIEN,"ING")
+14 SET LP2=0
FOR
SET LP2=$ORDER(ARY("ING",LP2))
IF 'LP2
QUIT
Begin DoDot:1
+15 SET FDA(120.824,"+"_$$INC()_","_IENS,.01)=$PIECE(ARY("ING",LP2,0),U)
End DoDot:1
+16 ;Effective Date
+17 KILL ^GMRD(120.82,DIEN,"TERMSTATUS")
+18 SET LP2=0
FOR
SET LP2=$ORDER(ARY("TERMSTATUS",LP2))
IF 'LP2
QUIT
Begin DoDot:1
+19 SET FDA(120.8299,"+"_$$INC()_","_IENS,.01)=$PIECE(ARY("TERMSTATUS",LP2,0),U)
+20 SET FDA(120.8299,"+"_$$INC(0)_","_IENS,.02)=$PIECE(ARY("TERMSTATUS",LP2,0),U,2)
End DoDot:1
+21 KILL ERR
+22 DO UPDATE^DIE("","FDA","","ERR")
+23 IF $DATA(ERR)
WRITE !,IENS
WRITE ERR
WRITE !!
QUIT
+24 QUIT
+25 ; Increment counter
INC(VAL) ;EP-
+1 SET VAL=$GET(VAL,1)
+2 SET CNT=$GET(CNT)+VAL
+3 QUIT CNT
DIERR(XPDI) NEW XPD
+1 DO MSG^DIALOG("AE",.XPD)
IF '$DATA(XPD)
QUIT
+2 DO BMES^XPDUTL(XPDI)
DO MES^XPDUTL(.XPD)
+3 QUIT
+4 ; Check existence of entry
EXISTS(NAM) ;EP -
+1 QUIT $ORDER(LNAARY(NAM,0))>0
+2 ; Get Allergy IEN from Local National Allergies
ALGIEN(NAM) ;EP-
+1 QUIT $ORDER(LNAARY(NAM,0))
+2 ; Check for Drug Allergy
DRUG(IEN) ;EP-
+1 QUIT $PIECE($GET(^GMRD(120.82,IEN,0)),U,2)["D"
+2 ;
PRETRAN ;EP -
+1 NEW FNAM,FILE
+2 SET FILE=120.82
+3 SET FNAM="GMR ALLERGIES"
+4 DO FIA^DIFROMSU(FILE,"",FNAM,XPDGREF,"n^n^f^^n^^y^m^n","","I $P(^(0),U,3)=1",4.0)
+5 DO DATAOUT^DIFROMS("","","",XPDGREF)
+6 QUIT
