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

GMRA1008.m

Go to the documentation of this file. 
  1. GMRA1008 ;IHS/MSC/PLS - Patch support;19-Sep-2014 10:02;DU
  1.  ;;4.0;Adverse Reaction Tracking;**1008**;Mar 29, 1996;Build 8
  1.  ;
  1. ENV ;EP -
  1.  N PATCH
  1.  S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1.  ;
  1.  ;Check for the installation of other patches
  1.  S PATCH="GMRA*4.0*1007"
  1.  I '$$PATCH(PATCH) D  Q
  1.  . W !,"You must first install "_PATCH_"." S XPDQUIT=2
  1.  Q
  1.  ;
  1. 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
  1.  Q:X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.4N 0
  1.  NEW NUM,I,J
  1.  S I=$O(^DIC(9.4,"C",$P(X,"*"),0)) Q:'I 0
  1.  S J=$O(^DIC(9.4,I,22,"B",$P(X,"*",2),0)),X=$P(X,"*",3) Q:'J 0
  1.  ;check if patch is just a number
  1.  Q:$O(^DIC(9.4,I,22,J,"PAH","B",X,0)) 1
  1.  S NUM=$O(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ"))
  1.  Q (X=+NUM)
  1. PRE ;EP -
  1.  ;Loop through the allergy file and remove any bad cross-references to
  1.  ;the drug file that are found there
  1.  N IEN,AIEN,FDA,X,X1,X2
  1.  S IEN=0 F  S IEN=$O(^GMR(120.8,IEN)) Q:'+IEN  D
  1.  .S X=$P($G(^GMR(120.8,IEN,0)),U,3)
  1.  .I X[$C(34) D
  1.  ..S X1=$P(X,$C(34))
  1.  ..S X2=X1_","
  1.  ..S AIEN=IEN_","
  1.  ..S FDA(120.8,AIEN,1)=X2
  1.  ..D UPDATE^DIE(,"FDA","DIEN","ERR")
  1.  Q
  1. POST ;EP -
  1.  D DATA,SIGNS
  1.  D INACT
  1.  ;D TOP10^GMRAUTL2
  1.  Q
  1. INACT ;EP Remove duplicate caterpillar entries
  1.  N IEN,X,SAVE
  1.  S SAVE=0
  1.  S IEN="" F  S IEN=$O(^GMRD(120.82,"B","CATERPILLER STING",IEN)) Q:IEN=""  D
  1.  .S X=$$CHECK^ORWDAL32(IEN)
  1.  .I X=0  D INAC(IEN)
  1.  Q
  1. INAC(IEN) ;Inactivate this entry
  1.  K ERR,FDA,NIEN,FNUM
  1.  S FNUM=120.8299
  1.  S AIEN="+1,"_IEN_","
  1.  S FDA(120.8299,AIEN,.01)=$$NOW^XLFDT
  1.  S FDA(120.8299,AIEN,.02)=0
  1.  D UPDATE^DIE(,"FDA","NIEN","ERR")
  1.  I $D(ERR) W !,IENS W ERR("DIERR",1,"TEXT",1) W !
  1.  Q
  1.  ;
  1. SIGNS ;EP-
  1.  N F,LP,NAM
  1.  S F=120.83
  1.  D DATAIN^DIFROMS(F,"","",XPDGREF),DIERR("** ERROR IN DATA FOR FILE # "_F_" **"):$D(DIERR)
  1.  Q
  1.  ;
  1. DATA ; Import Data
  1.  N LP,NAM,F,LNAARY,XUMF
  1.  ; Build array of local national allergies
  1.  S LP=0 F  S LP=$O(^GMRD(120.82,LP)) Q:'LP  D
  1.  .Q:'$P(^GMRD(120.82,LP,0),U,3)  ;Must be a National Allergy
  1.  .S LNAARY($P(^GMRD(120.82,LP,0),U),LP)=""
  1.  S F=120.82,XUMF=1
  1.  S LP=0 F  S LP=$O(@XPDGREF@("DATA",F,LP)) Q:'LP  D
  1.  .Q:'$P(@XPDGREF@("DATA",F,LP,0),U,3)  ; Must be marked as National Allergy
  1.  .S NAM=$P($G(@XPDGREF@("DATA",F,LP,0)),U)
  1.  .D STOREALG(LP)
  1.  Q
  1.  ;
  1. STOREALG(DATAIEN) ;
  1.  N FDA,FDAIEN,ERR,IENS,ARY,LP2,CNT,IEN
  1.  Q:'$L(DATAIEN)
  1.  M ARY=@XPDGREF@("DATA",120.82,DATAIEN)
  1.  S IEN=$$ALGIEN(NAM)
  1.  S:'IEN IEN="+1"
  1.  S IENS=IEN_",",X=IEN
  1.  S CNT=0
  1.  I X=+X D  ;EXISTING ENTRY
  1.  .S FDA(F,IENS,1)=$P(ARY(0),U,2)
  1.  .S FDA(F,IENS,2)=$P(ARY(0),U,3)
  1.  .S FDA(F,IENS,99.99)=$P($G(ARY("VUID")),U,1)
  1.  .S FDA(F,IENS,99.98)=$P($G(ARY("VUID")),U,2)
  1.  .D FILE^DIE("K","FDA","ERR")
  1.  .Q:$D(ERR)
  1.  .D SUBDATA(IEN)
  1.  E  D  ;New entry
  1.  .S FDA(F,IENS,.01)=$P(ARY(0),U)
  1.  .S FDA(F,IENS,1)=$P(ARY(0),U,2)
  1.  .S FDA(F,IENS,2)=$P(ARY(0),U,3)
  1.  .S FDA(F,IENS,99.99)=$P($G(ARY("VUID")),U,1)
  1.  .S FDA(F,IENS,99.98)=$P($G(ARY("VUID")),U,2)
  1.  .D UPDATE^DIE("","FDA","IENS","ERR")
  1.  .I $D(ERR) W !,IENS W ERR W !! Q
  1.  .D SUBDATA(IENS(1))
  1.  Q
  1.  ; Add subfile data
  1. SUBDATA(DIEN) ;EP-
  1.  N IENS
  1.  S IENS=DIEN_","
  1.  ; KILL EXISTING SUBFILE DATA
  1.  ;Synonyms
  1.  K ^GMRD(120.82,DIEN,3)
  1.  S LP2=0 F  S LP2=$O(ARY(3,LP2)) Q:'LP2  D
  1.  .S FDA(120.823,"+"_$$INC()_","_IENS,.01)=$P(ARY(3,LP2,0),U)
  1.  ;Drug Class
  1.  K ^GMRD(120.82,DIEN,"CLASS")
  1.  S LP2=0 F  S LP2=$O(ARY("CLASS",LP2)) Q:'LP2  D
  1.  .S FDA(120.8205,"+"_$$INC()_","_IENS,.01)=$P(ARY("CLASS",LP2,0),U)
  1.  ;Drug Ingredient
  1.  K ^GMRD(120.82,DIEN,"ING")
  1.  S LP2=0 F  S LP2=$O(ARY("ING",LP2)) Q:'LP2  D
  1.  .S FDA(120.824,"+"_$$INC()_","_IENS,.01)=$P(ARY("ING",LP2,0),U)
  1.  ;Effective Date
  1.  K ^GMRD(120.82,DIEN,"TERMSTATUS")
  1.  S LP2=0 F  S LP2=$O(ARY("TERMSTATUS",LP2)) Q:'LP2  D
  1.  .S FDA(120.8299,"+"_$$INC()_","_IENS,.01)=$P(ARY("TERMSTATUS",LP2,0),U)
  1.  .S FDA(120.8299,"+"_$$INC(0)_","_IENS,.02)=$P(ARY("TERMSTATUS",LP2,0),U,2)
  1.  K ERR
  1.  D UPDATE^DIE("","FDA","","ERR")
  1.  I $D(ERR) W !,IENS W ERR("DIERR",1,"TEXT",1) W !! Q
  1.  Q
  1.  ; Increment counter
  1. INC(VAL) ;EP-
  1.  S VAL=$G(VAL,1)
  1.  S CNT=$G(CNT)+VAL
  1.  Q CNT
  1. DIERR(XPDI) N XPD
  1.  D MSG^DIALOG("AE",.XPD) Q:'$D(XPD)
  1.  D BMES^XPDUTL(XPDI),MES^XPDUTL(.XPD)
  1.  Q
  1.  ; Check existence of entry
  1. EXISTS(NAM) ;EP -
  1.  Q $O(LNAARY(NAM,0))>0
  1.  ; Get Allergy IEN from Local National Allergies
  1. ALGIEN(NAM) ;EP-
  1.  Q $O(LNAARY(NAM,0))
  1.  ; Check for Drug Allergy
  1. DRUG(IEN) ;EP-
  1.  Q $P($G(^GMRD(120.82,IEN,0)),U,2)["D"
  1.  ;
  1. PRETRAN ;EP -
  1.  D PRELOOP(120.82,"GMR ALLERGIES",""),PRELOOP(120.83,"SIGN/SYMPTOMS","")
  1.  Q
  1. PRELOOP(FILE,FNAM,SCRN) ;EP-
  1.  D FIA^DIFROMSU(FILE,"",FNAM,XPDGREF,"n^n^f^^n^^y^m^n","",SCRN,4.0)
  1.  D DATAOUT^DIFROMS("","","",XPDGREF)
  1.  Q