GMRA1007 ;IHS/MSC/PLS - Patch support;24-Mar-2014 12:10;DU
;;4.0;Adverse Reaction Tracking;**1007**;Mar 29, 1996;Build 18
;
ENV ;EP -
N PATCH
S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
;
;Check for the installation of other patches
S PATCH="GMRA*4.0*1006"
I '$$PATCH(PATCH) D Q
. W !,"You must first install "_PATCH_"." S XPDQUIT=2
;Check for the installation of IHS terminology services
S IN="IHS STANDARD TERMINOLOGY 1.0",INSTDA=""
I '$D(^XPD(9.7,"B",IN)) D Q
.W !,"You must first install IHS STANDARD TERMINOLOGY 1.0 before this patch"
S INSTDA=$O(^XPD(9.7,"B",IN,INSTDA),-1)
S STAT=+$P($G(^XPD(9.7,INSTDA,0)),U,9)
I STAT'=3 D Q
.W !,"IHS STANDARD TERMINOLOGY 1.0 must be completely installed before installing this patch"
S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
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 -
Q
POST ;EP Run the post-init routines
D EVENTS
D INACT
D ADDSYM
D ADDING
S X=$$ADD^XPDMENU("GMRA CLINICIAN MENU","GMRAZ NO ALLERGY ASSESSMENT","8")
I 'X W "Attempt to add GMRA menu option option failed." H 3
Q
EVENTS ;Enter old SNOMED event codes
N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,DIR
S ZTRTN="UPDATE^GMRA1007",ZTIO="",ZTSAVE("DUZ")=""
S ZTDESC="Store Event Codes, SNOMEDs and UNIIs on old allergies"
D ^%ZTLOAD
I $G(ZTSK) D
.K ^XTMP("GMRA1007")
.N X,X1,X2 S X1=DT,X2=30
.D C^%DTC
.S ^XTMP("GMRA1007",0)=X_"^"_DT_"^"
.S ^XTMP("GMRA1007","COUNT")=0
.W !!,"A task has been queued in the background."
.W !," The task number is "_$G(ZTSK)_"."
.W !," To check on the status of the task, in programmer mode "
.W !," type D STATUS^GMRA1007"
N X
Q
UPDATE ; Run the post-init
S ^XTMP("GMRA1007","STARTDT")=$$NOW^XLFDT
D EVENT
D BACKLOAD^GMRAZRXU
S ^XTMP("GMRA1007","ENDDT")=$$NOW^XLFDT
D MAIL
Q
EVENT ; EP Populate old allergies with event codes
N IEN,TYPE,CNT,ECNT,EIE,MECH
S CNT=0,ECNT=0
S IEN=0 F S IEN=$O(^GMR(120.8,IEN)) Q:'+IEN D
.S EIE=$$GET1^DIQ(120.8,IEN,22)
.Q:EIE'=""
.I $P($G(^GMR(120.8,IEN,9999999.11)),U,2)="" D
..S TYPE=$$GET1^DIQ(120.8,IEN,3.1,"I")
..S MECH=$$GET1^DIQ(120.8,IEN,17,"I")
..I MECH="" S MECH="U"
..I TYPE="" S TYPE="O"
..D ADD(IEN,MECH,TYPE)
Q
ADD(IEN,MECH,TYPE) ;ADD the event code
N SNO,IENS,ERR,SNOIEN,FDA
I MECH="A" D
.S SNO=$S(TYPE="D":"DRUG ALLERGY",TYPE="F":"FOOD ALLERGY",1:"ALLERGY TO SUBSTANCE")
I MECH="P" D
.S SNO=$S(TYPE="D":"DRUG INTOLERANCE",TYPE="F":"FOOD INTOLERANCE",1:"PROPENSITY TO ADVERSE REACTIONS TO SUBSTANCE")
I MECH="U" D
.S SNO=$S(TYPE="D":"PROPENSITY TO ADVERSE REACTIONS TO DRUG",TYPE="F":"FOOD INTOLERANCE",1:"PROPENSITY TO ADVERSE REACTIONS TO SUBSTANCE")
S SNOIEN=$O(^BEHOAR(90460.06,"B",SNO,""))
S IENS=IEN_","
K AIEN,ERR
S FDA(120.8,IENS,9999999.13)=SNOIEN
D UPDATE^DIE("","FDA","AIEN","ERR")
K FDA,AIEN,ERR
Q
STATUS ;check on status of VS xref indexing
I $G(^XTMP("GMRA1007","ENDDT")) D
. N START,END,X,Y
. W !,"Data update completed!"
. S Y=$G(^XTMP("GMRA1007","STARTDT")) D DD^%DT
. W !,"Task started: "_Y
. S Y=$G(^XTMP("GMRA1007","ENDDT")) D DD^%DT
. W !,"Task ended: "_Y
I '$G(^XTMP("GMRA1007","ENDDT")) D
. W !,"Still working on the update."
. I $G(^XTMP("GMRA1007","COUNT"))=0 W !,"You must have tasked it!"
Q
INACT ;EP Remove duplicate toothpaste entries
N IEN,X,SAVE
S SAVE=0
S IEN="" F S IEN=$O(^GMRD(120.82,"B","TOOTHPASTE",IEN)) Q:IEN="" D
.S X=$$CHECK^ORWDAL32(IEN)
.I X=0&(SAVE=0) S SAVE=1
.E I X=0&(SAVE=1) 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
MAIL ;Send completion message to user who initiated post-install
N XMSUB,XMTEXT,XMDUZ,XMY,XMZ,XMMG,TXT,GMRATXT
S XMDUZ="PATCH GMRA*4*1007 Backload event codes",XMY(.5)=""
S:$G(DUZ) XMY(DUZ)=""
S GMRATXT(1)="Backload SNOMED and UNII codes"
S GMRATXT(2)=""
S GMRATXT(3)="Task Started: "_$$FMTE^XLFDT($G(^XTMP("GMRA1007","STARTDT")))
S GMRATXT(4)="Task Ended: "_$$FMTE^XLFDT($G(^XTMP("GMRA1007","ENDDT")))
S GMRATXT(5)=""
S XMTEXT="GMRATXT(",XMSUB="GMRA*4*1007 SNOMED Event backload"
D ^XMD
Q
ADDSYM ;Add new symptom to the file
N XUMF,FDA,IEN,IENS,ERR,FILE,SIEN,SIGN,SYN,SYNIEN
S SIGN="THROAT IRRITATION"
S SYN="ITCHING OF THROAT"
S SIEN=$O(^GMRD(120.83,"B",SIGN,"")) Q:SIEN="" D
.S SYNIEN=$O(^GMRD(120.83,SIEN,2,"B",SYN,"")) Q:SYNIEN'="" D
..S XUMF=1,FILE=120.832
..S IENS="+1,"_SIEN_","
..S FDA(FILE,IENS,.01)=SYN
..D UPDATE^DIE("","FDA","IENS","ERR")
Q
ADDING ;Add new ingredient to the file
N SULFA,ING,INGIEN,SULIEN,IENS,IEN2,ERR,FDA,FILE,IENS,IN,X,PT,RXNORM,UNII
S SULFA="SULFA DRUGS"
S ING="SULFISOXAZOLE"
S INGIEN="" S INGIEN=$O(^PS(50.416,"B",ING,INGIEN))
Q:INGIEN=""
S SULIEN="" S SULIEN=$O(^GMRD(120.82,"B",SULFA,SULIEN))
Q:SULIEN=""
S XUMF=1,FILE=120.824
;Continue if its not already there
S ERR=""
I $D(^GMRD(120.82,SULIEN,"ING","B",INGIEN))=0 D
.S IENS="+1,"_SULIEN_","
.S FDA(FILE,IENS,.01)=INGIEN
.D UPDATE^DIE("","FDA","IEN2","ERR")
Q:ERR
;Next update users with this allergy
S IN=ING_U_"32771^^1"
S X=$$ASSOC^BSTSAPI(IN)
I $P(X,U,2)'=""!($P(X,U,3)'="") D
.S RXNORM=$P(X,U,2),UNII=$P(X,U,3)
S PT="" F S PT=$O(^GMR(120.8,"C",SULFA,PT)) Q:'+PT D
.I $D(^GMR(120.8,PT,2,"B",INGIEN))=0 D
..K FDA,IENS,IEN2
..S IENS="+1,"_PT_","
..S FDA(120.802,IENS,.01)=INGIEN
..S FDA(120.802,IENS,9999999.01)=RXNORM
..S FDA(120.802,IENS,9999999.02)=UNII
..D UPDATE^DIE(,"FDA","IEN2","ERR")
Q
GMRA1007 ;IHS/MSC/PLS - Patch support;24-Mar-2014 12:10;DU
+1 ;;4.0;Adverse Reaction Tracking;**1007**;Mar 29, 1996;Build 18
+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*1006"
+6 IF '$$PATCH(PATCH)
Begin DoDot:1
+7 WRITE !,"You must first install "_PATCH_"."
SET XPDQUIT=2
End DoDot:1
QUIT
+8 ;Check for the installation of IHS terminology services
+9 SET IN="IHS STANDARD TERMINOLOGY 1.0"
SET INSTDA=""
+10 IF '$DATA(^XPD(9.7,"B",IN))
Begin DoDot:1
+11 WRITE !,"You must first install IHS STANDARD TERMINOLOGY 1.0 before this patch"
End DoDot:1
QUIT
+12 SET INSTDA=$ORDER(^XPD(9.7,"B",IN,INSTDA),-1)
+13 SET STAT=+$PIECE($GET(^XPD(9.7,INSTDA,0)),U,9)
+14 IF STAT'=3
Begin DoDot:1
+15 WRITE !,"IHS STANDARD TERMINOLOGY 1.0 must be completely installed before installing this patch"
End DoDot:1
QUIT
+16 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+17 QUIT
+18 ;
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 QUIT
POST ;EP Run the post-init routines
+1 DO EVENTS
+2 DO INACT
+3 DO ADDSYM
+4 DO ADDING
+5 SET X=$$ADD^XPDMENU("GMRA CLINICIAN MENU","GMRAZ NO ALLERGY ASSESSMENT","8")
+6 IF 'X
WRITE "Attempt to add GMRA menu option option failed."
HANG 3
+7 QUIT
EVENTS ;Enter old SNOMED event codes
+1 NEW ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,DIR
+2 SET ZTRTN="UPDATE^GMRA1007"
SET ZTIO=""
SET ZTSAVE("DUZ")=""
+3 SET ZTDESC="Store Event Codes, SNOMEDs and UNIIs on old allergies"
+4 DO ^%ZTLOAD
+5 IF $GET(ZTSK)
Begin DoDot:1
+6 KILL ^XTMP("GMRA1007")
+7 NEW X,X1,X2
SET X1=DT
SET X2=30
+8 DO C^%DTC
+9 SET ^XTMP("GMRA1007",0)=X_"^"_DT_"^"
+10 SET ^XTMP("GMRA1007","COUNT")=0
+11 WRITE !!,"A task has been queued in the background."
+12 WRITE !," The task number is "_$GET(ZTSK)_"."
+13 WRITE !," To check on the status of the task, in programmer mode "
+14 WRITE !," type D STATUS^GMRA1007"
End DoDot:1
+15 NEW X
+16 QUIT
UPDATE ; Run the post-init
+1 SET ^XTMP("GMRA1007","STARTDT")=$$NOW^XLFDT
+2 DO EVENT
+3 DO BACKLOAD^GMRAZRXU
+4 SET ^XTMP("GMRA1007","ENDDT")=$$NOW^XLFDT
+5 DO MAIL
+6 QUIT
EVENT ; EP Populate old allergies with event codes
+1 NEW IEN,TYPE,CNT,ECNT,EIE,MECH
+2 SET CNT=0
SET ECNT=0
+3 SET IEN=0
FOR
SET IEN=$ORDER(^GMR(120.8,IEN))
IF '+IEN
QUIT
Begin DoDot:1
+4 SET EIE=$$GET1^DIQ(120.8,IEN,22)
+5 IF EIE'=""
QUIT
+6 IF $PIECE($GET(^GMR(120.8,IEN,9999999.11)),U,2)=""
Begin DoDot:2
+7 SET TYPE=$$GET1^DIQ(120.8,IEN,3.1,"I")
+8 SET MECH=$$GET1^DIQ(120.8,IEN,17,"I")
+9 IF MECH=""
SET MECH="U"
+10 IF TYPE=""
SET TYPE="O"
+11 DO ADD(IEN,MECH,TYPE)
End DoDot:2
End DoDot:1
+12 QUIT
ADD(IEN,MECH,TYPE) ;ADD the event code
+1 NEW SNO,IENS,ERR,SNOIEN,FDA
+2 IF MECH="A"
Begin DoDot:1
+3 SET SNO=$SELECT(TYPE="D":"DRUG ALLERGY",TYPE="F":"FOOD ALLERGY",1:"ALLERGY TO SUBSTANCE")
End DoDot:1
+4 IF MECH="P"
Begin DoDot:1
+5 SET SNO=$SELECT(TYPE="D":"DRUG INTOLERANCE",TYPE="F":"FOOD INTOLERANCE",1:"PROPENSITY TO ADVERSE REACTIONS TO SUBSTANCE")
End DoDot:1
+6 IF MECH="U"
Begin DoDot:1
+7 SET SNO=$SELECT(TYPE="D":"PROPENSITY TO ADVERSE REACTIONS TO DRUG",TYPE="F":"FOOD INTOLERANCE",1:"PROPENSITY TO ADVERSE REACTIONS TO SUBSTANCE")
End DoDot:1
+8 SET SNOIEN=$ORDER(^BEHOAR(90460.06,"B",SNO,""))
+9 SET IENS=IEN_","
+10 KILL AIEN,ERR
+11 SET FDA(120.8,IENS,9999999.13)=SNOIEN
+12 DO UPDATE^DIE("","FDA","AIEN","ERR")
+13 KILL FDA,AIEN,ERR
+14 QUIT
STATUS ;check on status of VS xref indexing
+1 IF $GET(^XTMP("GMRA1007","ENDDT"))
Begin DoDot:1
+2 NEW START,END,X,Y
+3 WRITE !,"Data update completed!"
+4 SET Y=$GET(^XTMP("GMRA1007","STARTDT"))
DO DD^%DT
+5 WRITE !,"Task started: "_Y
+6 SET Y=$GET(^XTMP("GMRA1007","ENDDT"))
DO DD^%DT
+7 WRITE !,"Task ended: "_Y
End DoDot:1
+8 IF '$GET(^XTMP("GMRA1007","ENDDT"))
Begin DoDot:1
+9 WRITE !,"Still working on the update."
+10 IF $GET(^XTMP("GMRA1007","COUNT"))=0
WRITE !,"You must have tasked it!"
End DoDot:1
+11 QUIT
INACT ;EP Remove duplicate toothpaste entries
+1 NEW IEN,X,SAVE
+2 SET SAVE=0
+3 SET IEN=""
FOR
SET IEN=$ORDER(^GMRD(120.82,"B","TOOTHPASTE",IEN))
IF IEN=""
QUIT
Begin DoDot:1
+4 SET X=$$CHECK^ORWDAL32(IEN)
+5 IF X=0&(SAVE=0)
SET SAVE=1
+6 IF '$TEST
IF X=0&(SAVE=1)
DO INAC(IEN)
End DoDot:1
+7 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
MAIL ;Send completion message to user who initiated post-install
+1 NEW XMSUB,XMTEXT,XMDUZ,XMY,XMZ,XMMG,TXT,GMRATXT
+2 SET XMDUZ="PATCH GMRA*4*1007 Backload event codes"
SET XMY(.5)=""
+3 IF $GET(DUZ)
SET XMY(DUZ)=""
+4 SET GMRATXT(1)="Backload SNOMED and UNII codes"
+5 SET GMRATXT(2)=""
+6 SET GMRATXT(3)="Task Started: "_$$FMTE^XLFDT($GET(^XTMP("GMRA1007","STARTDT")))
+7 SET GMRATXT(4)="Task Ended: "_$$FMTE^XLFDT($GET(^XTMP("GMRA1007","ENDDT")))
+8 SET GMRATXT(5)=""
+9 SET XMTEXT="GMRATXT("
SET XMSUB="GMRA*4*1007 SNOMED Event backload"
+10 DO ^XMD
+11 QUIT
ADDSYM ;Add new symptom to the file
+1 NEW XUMF,FDA,IEN,IENS,ERR,FILE,SIEN,SIGN,SYN,SYNIEN
+2 SET SIGN="THROAT IRRITATION"
+3 SET SYN="ITCHING OF THROAT"
+4 SET SIEN=$ORDER(^GMRD(120.83,"B",SIGN,""))
IF SIEN=""
QUIT
Begin DoDot:1
+5 SET SYNIEN=$ORDER(^GMRD(120.83,SIEN,2,"B",SYN,""))
IF SYNIEN'=""
QUIT
Begin DoDot:2
+6 SET XUMF=1
SET FILE=120.832
+7 SET IENS="+1,"_SIEN_","
+8 SET FDA(FILE,IENS,.01)=SYN
+9 DO UPDATE^DIE("","FDA","IENS","ERR")
End DoDot:2
End DoDot:1
+10 QUIT
ADDING ;Add new ingredient to the file
+1 NEW SULFA,ING,INGIEN,SULIEN,IENS,IEN2,ERR,FDA,FILE,IENS,IN,X,PT,RXNORM,UNII
+2 SET SULFA="SULFA DRUGS"
+3 SET ING="SULFISOXAZOLE"
+4 SET INGIEN=""
SET INGIEN=$ORDER(^PS(50.416,"B",ING,INGIEN))
+5 IF INGIEN=""
QUIT
+6 SET SULIEN=""
SET SULIEN=$ORDER(^GMRD(120.82,"B",SULFA,SULIEN))
+7 IF SULIEN=""
QUIT
+8 SET XUMF=1
SET FILE=120.824
+9 ;Continue if its not already there
+10 SET ERR=""
+11 IF $DATA(^GMRD(120.82,SULIEN,"ING","B",INGIEN))=0
Begin DoDot:1
+12 SET IENS="+1,"_SULIEN_","
+13 SET FDA(FILE,IENS,.01)=INGIEN
+14 DO UPDATE^DIE("","FDA","IEN2","ERR")
End DoDot:1
+15 IF ERR
QUIT
+16 ;Next update users with this allergy
+17 SET IN=ING_U_"32771^^1"
+18 SET X=$$ASSOC^BSTSAPI(IN)
+19 IF $PIECE(X,U,2)'=""!($PIECE(X,U,3)'="")
Begin DoDot:1
+20 SET RXNORM=$PIECE(X,U,2)
SET UNII=$PIECE(X,U,3)
End DoDot:1
+21 SET PT=""
FOR
SET PT=$ORDER(^GMR(120.8,"C",SULFA,PT))
IF '+PT
QUIT
Begin DoDot:1
+22 IF $DATA(^GMR(120.8,PT,2,"B",INGIEN))=0
Begin DoDot:2
+23 KILL FDA,IENS,IEN2
+24 SET IENS="+1,"_PT_","
+25 SET FDA(120.802,IENS,.01)=INGIEN
+26 SET FDA(120.802,IENS,9999999.01)=RXNORM
+27 SET FDA(120.802,IENS,9999999.02)=UNII
+28 DO UPDATE^DIE(,"FDA","IEN2","ERR")
End DoDot:2
End DoDot:1
+29 QUIT
