GMRA1008 ;IHS/MSC/PLS - Patch support;19-Sep-2014 10:02;DU
;;4.0;Adverse Reaction Tracking;**1008**;Mar 29, 1996;Build 8
;
ENV ;EP -
N PATCH
S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
;
;Check for the installation of other patches
S PATCH="GMRA*4.0*1007"
I '$$PATCH(PATCH) D Q
. W !,"You must first install "_PATCH_"." S XPDQUIT=2
Q
;
PATCH(X) ;return 1 if patch X was installed, X=aaaa*nn.nn*nnnn
;copy of code from XPDUTL but modified to handle 4 digit IHS patch numb
Q:X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.4N 0
NEW NUM,I,J
S I=$O(^DIC(9.4,"C",$P(X,"*"),0)) Q:'I 0
S J=$O(^DIC(9.4,I,22,"B",$P(X,"*",2),0)),X=$P(X,"*",3) Q:'J 0
;check if patch is just a number
Q:$O(^DIC(9.4,I,22,J,"PAH","B",X,0)) 1
S NUM=$O(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ"))
Q (X=+NUM)
PRE ;EP -
;Loop through the allergy file and remove any bad cross-references to
;the drug file that are found there
N IEN,AIEN,FDA,X,X1,X2
S IEN=0 F S IEN=$O(^GMR(120.8,IEN)) Q:'+IEN D
.S X=$P($G(^GMR(120.8,IEN,0)),U,3)
.I X[$C(34) D
..S X1=$P(X,$C(34))
..S X2=X1_","
..S AIEN=IEN_","
..S FDA(120.8,AIEN,1)=X2
..D UPDATE^DIE(,"FDA","DIEN","ERR")
Q
POST ;EP -
D DATA,SIGNS
D INACT
;D TOP10^GMRAUTL2
Q
INACT ;EP Remove duplicate caterpillar entries
N IEN,X,SAVE
S SAVE=0
S IEN="" F S IEN=$O(^GMRD(120.82,"B","CATERPILLER STING",IEN)) Q:IEN="" D
.S X=$$CHECK^ORWDAL32(IEN)
.I X=0 D INAC(IEN)
Q
INAC(IEN) ;Inactivate this entry
K ERR,FDA,NIEN,FNUM
S FNUM=120.8299
S AIEN="+1,"_IEN_","
S FDA(120.8299,AIEN,.01)=$$NOW^XLFDT
S FDA(120.8299,AIEN,.02)=0
D UPDATE^DIE(,"FDA","NIEN","ERR")
I $D(ERR) W !,IENS W ERR("DIERR",1,"TEXT",1) W !
Q
;
SIGNS ;EP-
N F,LP,NAM
S F=120.83
D DATAIN^DIFROMS(F,"","",XPDGREF),DIERR("** ERROR IN DATA FOR FILE # "_F_" **"):$D(DIERR)
Q
;
DATA ; Import Data
N LP,NAM,F,LNAARY,XUMF
; 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,XUMF=1
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_",",X=IEN
S CNT=0
I X=+X D ;EXISTING ENTRY
.S FDA(F,IENS,1)=$P(ARY(0),U,2)
.S FDA(F,IENS,2)=$P(ARY(0),U,3)
.S FDA(F,IENS,99.99)=$P($G(ARY("VUID")),U,1)
.S FDA(F,IENS,99.98)=$P($G(ARY("VUID")),U,2)
.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)
.S FDA(F,IENS,99.99)=$P($G(ARY("VUID")),U,1)
.S FDA(F,IENS,99.98)=$P($G(ARY("VUID")),U,2)
.D UPDATE^DIE("","FDA","IENS","ERR")
.I $D(ERR) W !,IENS W ERR W !! Q
.D SUBDATA(IENS(1))
Q
; 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("DIERR",1,"TEXT",1) 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 -
D PRELOOP(120.82,"GMR ALLERGIES",""),PRELOOP(120.83,"SIGN/SYMPTOMS","")
Q
PRELOOP(FILE,FNAM,SCRN) ;EP-
D FIA^DIFROMSU(FILE,"",FNAM,XPDGREF,"n^n^f^^n^^y^m^n","",SCRN,4.0)
D DATAOUT^DIFROMS("","","",XPDGREF)
Q
GMRA1008 ;IHS/MSC/PLS - Patch support;19-Sep-2014 10:02;DU
+1 ;;4.0;Adverse Reaction Tracking;**1008**;Mar 29, 1996;Build 8
+2 ;
ENV ;EP -
+1 NEW PATCH
+2 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+3 ;
+4 ;Check for the installation of other patches
+5 SET PATCH="GMRA*4.0*1007"
+6 IF '$$PATCH(PATCH)
Begin DoDot:1
+7 WRITE !,"You must first install "_PATCH_"."
SET XPDQUIT=2
End DoDot:1
QUIT
+8 QUIT
+9 ;
PATCH(X) ;return 1 if patch X was installed, X=aaaa*nn.nn*nnnn
+1 ;copy of code from XPDUTL but modified to handle 4 digit IHS patch numb
+2 IF X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.4N
QUIT 0
+3 NEW NUM,I,J
+4 SET I=$ORDER(^DIC(9.4,"C",$PIECE(X,"*"),0))
IF 'I
QUIT 0
+5 SET J=$ORDER(^DIC(9.4,I,22,"B",$PIECE(X,"*",2),0))
SET X=$PIECE(X,"*",3)
IF 'J
QUIT 0
+6 ;check if patch is just a number
+7 IF $ORDER(^DIC(9.4,I,22,J,"PAH","B",X,0))
QUIT 1
+8 SET NUM=$ORDER(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ"))
+9 QUIT (X=+NUM)
PRE ;EP -
+1 ;Loop through the allergy file and remove any bad cross-references to
+2 ;the drug file that are found there
+3 NEW IEN,AIEN,FDA,X,X1,X2
+4 SET IEN=0
FOR
SET IEN=$ORDER(^GMR(120.8,IEN))
IF '+IEN
QUIT
Begin DoDot:1
+5 SET X=$PIECE($GET(^GMR(120.8,IEN,0)),U,3)
+6 IF X[$CHAR(34)
Begin DoDot:2
+7 SET X1=$PIECE(X,$CHAR(34))
+8 SET X2=X1_","
+9 SET AIEN=IEN_","
+10 SET FDA(120.8,AIEN,1)=X2
+11 DO UPDATE^DIE(,"FDA","DIEN","ERR")
End DoDot:2
End DoDot:1
+12 QUIT
POST ;EP -
+1 DO DATA
DO SIGNS
+2 DO INACT
+3 ;D TOP10^GMRAUTL2
+4 QUIT
INACT ;EP Remove duplicate caterpillar entries
+1 NEW IEN,X,SAVE
+2 SET SAVE=0
+3 SET IEN=""
FOR
SET IEN=$ORDER(^GMRD(120.82,"B","CATERPILLER STING",IEN))
IF IEN=""
QUIT
Begin DoDot:1
+4 SET X=$$CHECK^ORWDAL32(IEN)
+5 IF X=0
DO INAC(IEN)
End DoDot:1
+6 QUIT
INAC(IEN) ;Inactivate this entry
+1 KILL ERR,FDA,NIEN,FNUM
+2 SET FNUM=120.8299
+3 SET AIEN="+1,"_IEN_","
+4 SET FDA(120.8299,AIEN,.01)=$$NOW^XLFDT
+5 SET FDA(120.8299,AIEN,.02)=0
+6 DO UPDATE^DIE(,"FDA","NIEN","ERR")
+7 IF $DATA(ERR)
WRITE !,IENS
WRITE ERR("DIERR",1,"TEXT",1)
WRITE !
+8 QUIT
+9 ;
SIGNS ;EP-
+1 NEW F,LP,NAM
+2 SET F=120.83
+3 DO DATAIN^DIFROMS(F,"","",XPDGREF)
IF $DATA(DIERR)
DO DIERR("** ERROR IN DATA FOR FILE # "_F_" **")
+4 QUIT
+5 ;
DATA ; Import Data
+1 NEW LP,NAM,F,LNAARY,XUMF
+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
SET XUMF=1
+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_","
SET X=IEN
+7 SET CNT=0
+8 ;EXISTING ENTRY
IF X=+X
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 SET FDA(F,IENS,99.99)=$PIECE($GET(ARY("VUID")),U,1)
+12 SET FDA(F,IENS,99.98)=$PIECE($GET(ARY("VUID")),U,2)
+13 DO FILE^DIE("K","FDA","ERR")
+14 IF $DATA(ERR)
QUIT
+15 DO SUBDATA(IEN)
End DoDot:1
+16 ;New entry
IF '$TEST
Begin DoDot:1
+17 SET FDA(F,IENS,.01)=$PIECE(ARY(0),U)
+18 SET FDA(F,IENS,1)=$PIECE(ARY(0),U,2)
+19 SET FDA(F,IENS,2)=$PIECE(ARY(0),U,3)
+20 SET FDA(F,IENS,99.99)=$PIECE($GET(ARY("VUID")),U,1)
+21 SET FDA(F,IENS,99.98)=$PIECE($GET(ARY("VUID")),U,2)
+22 DO UPDATE^DIE("","FDA","IENS","ERR")
+23 IF $DATA(ERR)
WRITE !,IENS
WRITE ERR
WRITE !!
QUIT
+24 DO SUBDATA(IENS(1))
End DoDot:1
+25 QUIT
+26 ; 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("DIERR",1,"TEXT",1)
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 DO PRELOOP(120.82,"GMR ALLERGIES","")
DO PRELOOP(120.83,"SIGN/SYMPTOMS","")
+2 QUIT
PRELOOP(FILE,FNAM,SCRN) ;EP-
+1 DO FIA^DIFROMSU(FILE,"",FNAM,XPDGREF,"n^n^f^^n^^y^m^n","",SCRN,4.0)
+2 DO DATAOUT^DIFROMS("","","",XPDGREF)
+3 QUIT
