GMRAY21 ;SLC/DAN Post-init for patch 21 ;12/23/04 12:17
;;4.0;Adverse Reaction Tracking;**21**;Mar 29, 1996
;
;DBIA SECTION
;10063 - %ZTLOAD
;3744 - $$TESTPAT^VADPT
;10013 - DIK
;10103 - XLFDT
;10070 - XMD
;10141 - XPDUTL
;
PRE ;Pre-install converts IODINE to allergy type of drug
N DIE,DA,DR
S DIE="^GMRD(120.82,",DA=$O(^GMRD(120.82,"B","IODINE",0)),DR="1////D"
I DA D ^DIE
Q
;
Q ;Entry point to queue process during install
N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
S ZTRTN="DQ^GMRAY21",ZTDESC="GMRA*4*21 POST INSTALL ROUTINE",ZTIO="",ZTDTH=$H
D ^%ZTLOAD I '$G(ZTSK) D BMES^XPDUTL("POST INSTALL NOT QUEUED - RUN DQ^GMRA21 AFTER INSTALL FINISHES") Q
D BMES^XPDUTL("Post-install queued as task # "_$G(ZTSK))
Q
;
DQ ;Dequeue
N PROB,GMRAIOD
D POST,IODINE,ADDB,MAIL
Q
;
POST ;Post-init entry point
N DA,GMRAI,GMRA0,LCV,DIK
;Check assessment level in 120.86 and make sure it makes the patient's actual assessment level
S GMRAI=0 F S GMRAI=$O(^GMR(120.86,GMRAI)) Q:'+GMRAI I $P(^(GMRAI,0),U,2),$$NKASCR^GMRANKA(GMRAI) S DIK="^GMR(120.86,",DA=GMRAI D ^DIK ;Delete assessment if patient doesn't have allergies and assessment is set to "has allergies"
;Find entries in 120.8 that are missing the reactant or are missing additional required data and take appropriate action.
S GMRAI=0 F S GMRAI=$O(^GMR(120.8,GMRAI)) Q:'+GMRAI D
.S GMRA0=$G(^GMR(120.8,GMRAI,0))
.I GMRA0=""!($L(GMRA0,"^")=1)!($P(GMRA0,"^",2,3)="^") S DIK="^GMR(120.8,",DA=GMRAI D ^DIK Q ;Delete entry if no zero node or only 1 piece on zero node or missing reactant data
.I $P(GMRA0,U,6)="o" D CHECKOBS
;Check observed data to make sure it's matched to the right patient
S LCV=0 F S LCV=$O(^GMR(120.85,LCV)) Q:'+LCV D
.S GMRA0=$G(^GMR(120.85,LCV,0)) Q:GMRA0=""
.I $P(GMRA0,U,2)'=$P($G(^GMR(120.8,$P(GMRA0,U,15),0)),U) S DIK="^GMR(120.85,",DA=LCV D ^DIK
Q
;
;
CHECKOBS ;Check observation data to make sure it's present and accurate
N J
Q:$D(^GMR(120.8,GMRAI,"ER"))!($$TESTPAT^VADPT($P(GMRA0,U)))!($$DECEASED^GMRAFX($P(GMRA0,U))) ;Stop if allergy entered in error, test patient or deceased patient
I $P(GMRA0,U,12)=1 D
.I '$D(^GMR(120.85,"C",GMRAI)) S PROB($P(GMRA0,U),GMRAI)="OBS" Q ;Marked as observed but no data
.S J=0 F S J=$O(^GMR(120.85,"C",GMRAI,J)) Q:'+J I '$O(^GMR(120.85,J,2,0)) S PROB($P(GMRA0,U),GMRAI)="SS" ;Has observed data but no sign/symptoms
Q
;
MAIL ;Send message indicating post install is finished
N XMSUB,XMTEXT,XMDUZ,XMY,XMZ,GMRATXT,DFN,PCNT,VADM,CNT,IEN
S XMDUZ="PATCH GMRA*4*21 POST-INSTALL",XMY(.5)="" S:$G(DUZ) XMY(DUZ)=""
S GMRATXT(1)="The post-install routine for patch GMRA*4*21"
S GMRATXT(2)="finished on "_$$FMTE^XLFDT($$NOW^XLFDT)_"."
S GMRATXT(3)=""
S CNT=3 I $D(PROB) D
.S CNT=CNT+1,GMRATXT(CNT)="The following patients have observed allergy entries that are"
.S CNT=CNT+1,GMRATXT(CNT)="signed off (accepted) but are missing required data. Please review each"
.S CNT=CNT+1,GMRATXT(CNT)="entry and update (if data is known), mark it as entered in error,"
.S CNT=CNT+1,GMRATXT(CNT)="or leave it alone."
.S CNT=CNT+1,GMRATXT(CNT)=""
.S PCNT=0
.F S PCNT=$O(PROB(PCNT)) Q:'+PCNT D
..S DFN=PCNT D DEM^VADPT
..S IEN=0 F S IEN=$O(PROB(PCNT,IEN)) Q:'+IEN D
...S CNT=CNT+1
...S GMRATXT(CNT)=VADM(1)_" "_VA("BID")_" "_$P(^GMR(120.8,IEN,0),U,2)_" missing "_$S(PROB(PCNT,IEN)="OBS":"observation date",1:"sign/symptoms")
..S CNT=CNT+1,GMRATXT(CNT)=""
I $D(GMRAIOD) D
.S CNT=CNT+1,GMRATXT(CNT)=$$REPEAT^XLFSTR("*",75),CNT=CNT+1,GMRATXT(CNT)=""
.S CNT=CNT+1,GMRATXT(CNT)="The following patients have had their IODINE allergies updated.",CNT=CNT+1,GMRATXT(CNT)="You should review them for accuracy.",CNT=CNT+1,GMRATXT(CNT)=""
.S DFN=0 F S DFN=$O(GMRAIOD(DFN)) Q:'+DFN K VADM D DEM^VADPT S CNT=CNT+1,GMRATXT(CNT)=VADM(1)_" "_VA("BID")
S XMTEXT="GMRATXT(",XMSUB="PATCH GMRA*4*21 Post Install COMPLETED"
D ^XMD
Q
;
IODINE ;Find existing IODINE allergies and update them
N GMRAIODN,GMRAI,PAT,GMRAPA,GMRAAR
S GMRAIODN=$O(^GMRD(120.82,"B","IODINE",0)) Q:'+GMRAIODN ;No IODINE entry
S (GMRAAR,GMRAIODN)=GMRAIODN_";GMRD(120.82,"
S GMRAI=0 F S GMRAI=$O(^GMR(120.8,"C","IODINE",GMRAI)) Q:'+GMRAI D
.S PAT=$P($G(^GMR(120.8,GMRAI,0)),U) Q:'+PAT ;No patient
.Q:$P($G(^GMR(120.8,GMRAI,0)),U,3)'=GMRAIODN ;Not the one we're looking for
.Q:$D(^GMR(120.8,GMRAI,"ER"))!($$DECEASED^GMRAFX(PAT)) ;Stop if entered in error or patient has expired
.S GMRAPA=GMRAI
.S DIE="^GMR(120.8,",DA=GMRAPA,DR="3.1////D" D ^DIE ;Update allergy type to drug
.D DELMUL^GMRAFX3(2),DELMUL^GMRAFX3(3) ;Delete any existing ingredients and drug classes for this allergy
.D UPDATE^GMRAPES1 ;add ingredients and drug classes from IODINE entry
.S GMRAIOD(PAT)=""
.Q
Q
;
ADDB ;Add B xref to reactions multiple in 120.85
N IEN,DA,DIK
S IEN=0 F S IEN=$O(^GMR(120.85,IEN)) Q:'+IEN I $D(^GMR(120.85,IEN,2)) D
.S $P(^GMR(120.85,IEN,2,0),U,2)="120.8502P"
.S DA(1)=IEN,DIK="^GMR(120.85,DA(1),2," D IXALL^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAY21 5047 printed Apr 09, 2024@20:45:02 Page 2
GMRAY21 ;SLC/DAN Post-init for patch 21 ;12/23/04 12:17
+1 ;;4.0;Adverse Reaction Tracking;**21**;Mar 29, 1996
+2 ;
+3 ;DBIA SECTION
+4 ;10063 - %ZTLOAD
+5 ;3744 - $$TESTPAT^VADPT
+6 ;10013 - DIK
+7 ;10103 - XLFDT
+8 ;10070 - XMD
+9 ;10141 - XPDUTL
+10 ;
PRE ;Pre-install converts IODINE to allergy type of drug
+1 NEW DIE,DA,DR
+2 SET DIE="^GMRD(120.82,"
SET DA=$ORDER(^GMRD(120.82,"B","IODINE",0))
SET DR="1////D"
+3 IF DA
DO ^DIE
+4 QUIT
+5 ;
Q ;Entry point to queue process during install
+1 NEW ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
+2 SET ZTRTN="DQ^GMRAY21"
SET ZTDESC="GMRA*4*21 POST INSTALL ROUTINE"
SET ZTIO=""
SET ZTDTH=$HOROLOG
+3 DO ^%ZTLOAD
IF '$GET(ZTSK)
DO BMES^XPDUTL("POST INSTALL NOT QUEUED - RUN DQ^GMRA21 AFTER INSTALL FINISHES")
QUIT
+4 DO BMES^XPDUTL("Post-install queued as task # "_$GET(ZTSK))
+5 QUIT
+6 ;
DQ ;Dequeue
+1 NEW PROB,GMRAIOD
+2 DO POST
DO IODINE
DO ADDB
DO MAIL
+3 QUIT
+4 ;
POST ;Post-init entry point
+1 NEW DA,GMRAI,GMRA0,LCV,DIK
+2 ;Check assessment level in 120.86 and make sure it makes the patient's actual assessment level
+3 ;Delete assessment if patient doesn't have allergies and assessment is set to "has allergies"
SET GMRAI=0
FOR
SET GMRAI=$ORDER(^GMR(120.86,GMRAI))
if '+GMRAI
QUIT
IF $PIECE(^(GMRAI,0),U,2)
IF $$NKASCR^GMRANKA(GMRAI)
SET DIK="^GMR(120.86,"
SET DA=GMRAI
DO ^DIK
+4 ;Find entries in 120.8 that are missing the reactant or are missing additional required data and take appropriate action.
+5 SET GMRAI=0
FOR
SET GMRAI=$ORDER(^GMR(120.8,GMRAI))
if '+GMRAI
QUIT
Begin DoDot:1
+6 SET GMRA0=$GET(^GMR(120.8,GMRAI,0))
+7 ;Delete entry if no zero node or only 1 piece on zero node or missing reactant data
IF GMRA0=""!($LENGTH(GMRA0,"^")=1)!($PIECE(GMRA0,"^",2,3)="^")
SET DIK="^GMR(120.8,"
SET DA=GMRAI
DO ^DIK
QUIT
+8 IF $PIECE(GMRA0,U,6)="o"
DO CHECKOBS
End DoDot:1
+9 ;Check observed data to make sure it's matched to the right patient
+10 SET LCV=0
FOR
SET LCV=$ORDER(^GMR(120.85,LCV))
if '+LCV
QUIT
Begin DoDot:1
+11 SET GMRA0=$GET(^GMR(120.85,LCV,0))
if GMRA0=""
QUIT
+12 IF $PIECE(GMRA0,U,2)'=$PIECE($GET(^GMR(120.8,$PIECE(GMRA0,U,15),0)),U)
SET DIK="^GMR(120.85,"
SET DA=LCV
DO ^DIK
End DoDot:1
+13 QUIT
+14 ;
+15 ;
CHECKOBS ;Check observation data to make sure it's present and accurate
+1 NEW J
+2 ;Stop if allergy entered in error, test patient or deceased patient
if $DATA(^GMR(120.8,GMRAI,"ER"))!($$TESTPAT^VADPT($PIECE(GMRA0,U)))!($$DECEASED^GMRAFX($PIECE(GMRA0,U)))
QUIT
+3 IF $PIECE(GMRA0,U,12)=1
Begin DoDot:1
+4 ;Marked as observed but no data
IF '$DATA(^GMR(120.85,"C",GMRAI))
SET PROB($PIECE(GMRA0,U),GMRAI)="OBS"
QUIT
+5 ;Has observed data but no sign/symptoms
SET J=0
FOR
SET J=$ORDER(^GMR(120.85,"C",GMRAI,J))
if '+J
QUIT
IF '$ORDER(^GMR(120.85,J,2,0))
SET PROB($PIECE(GMRA0,U),GMRAI)="SS"
End DoDot:1
+6 QUIT
+7 ;
MAIL ;Send message indicating post install is finished
+1 NEW XMSUB,XMTEXT,XMDUZ,XMY,XMZ,GMRATXT,DFN,PCNT,VADM,CNT,IEN
+2 SET XMDUZ="PATCH GMRA*4*21 POST-INSTALL"
SET XMY(.5)=""
if $GET(DUZ)
SET XMY(DUZ)=""
+3 SET GMRATXT(1)="The post-install routine for patch GMRA*4*21"
+4 SET GMRATXT(2)="finished on "_$$FMTE^XLFDT($$NOW^XLFDT)_"."
+5 SET GMRATXT(3)=""
+6 SET CNT=3
IF $DATA(PROB)
Begin DoDot:1
+7 SET CNT=CNT+1
SET GMRATXT(CNT)="The following patients have observed allergy entries that are"
+8 SET CNT=CNT+1
SET GMRATXT(CNT)="signed off (accepted) but are missing required data. Please review each"
+9 SET CNT=CNT+1
SET GMRATXT(CNT)="entry and update (if data is known), mark it as entered in error,"
+10 SET CNT=CNT+1
SET GMRATXT(CNT)="or leave it alone."
+11 SET CNT=CNT+1
SET GMRATXT(CNT)=""
+12 SET PCNT=0
+13 FOR
SET PCNT=$ORDER(PROB(PCNT))
if '+PCNT
QUIT
Begin DoDot:2
+14 SET DFN=PCNT
DO DEM^VADPT
+15 SET IEN=0
FOR
SET IEN=$ORDER(PROB(PCNT,IEN))
if '+IEN
QUIT
Begin DoDot:3
+16 SET CNT=CNT+1
+17 SET GMRATXT(CNT)=VADM(1)_" "_VA("BID")_" "_$PIECE(^GMR(120.8,IEN,0),U,2)_" missing "_$SELECT(PROB(PCNT,IEN)="OBS":"observation date",1:"sign/symptoms")
End DoDot:3
+18 SET CNT=CNT+1
SET GMRATXT(CNT)=""
End DoDot:2
End DoDot:1
+19 IF $DATA(GMRAIOD)
Begin DoDot:1
+20 SET CNT=CNT+1
SET GMRATXT(CNT)=$$REPEAT^XLFSTR("*",75)
SET CNT=CNT+1
SET GMRATXT(CNT)=""
+21 SET CNT=CNT+1
SET GMRATXT(CNT)="The following patients have had their IODINE allergies updated."
SET CNT=CNT+1
SET GMRATXT(CNT)="You should review them for accuracy."
SET CNT=CNT+1
SET GMRATXT(CNT)=""
+22 SET DFN=0
FOR
SET DFN=$ORDER(GMRAIOD(DFN))
if '+DFN
QUIT
KILL VADM
DO DEM^VADPT
SET CNT=CNT+1
SET GMRATXT(CNT)=VADM(1)_" "_VA("BID")
End DoDot:1
+23 SET XMTEXT="GMRATXT("
SET XMSUB="PATCH GMRA*4*21 Post Install COMPLETED"
+24 DO ^XMD
+25 QUIT
+26 ;
IODINE ;Find existing IODINE allergies and update them
+1 NEW GMRAIODN,GMRAI,PAT,GMRAPA,GMRAAR
+2 ;No IODINE entry
SET GMRAIODN=$ORDER(^GMRD(120.82,"B","IODINE",0))
if '+GMRAIODN
QUIT
+3 SET (GMRAAR,GMRAIODN)=GMRAIODN_";GMRD(120.82,"
+4 SET GMRAI=0
FOR
SET GMRAI=$ORDER(^GMR(120.8,"C","IODINE",GMRAI))
if '+GMRAI
QUIT
Begin DoDot:1
+5 ;No patient
SET PAT=$PIECE($GET(^GMR(120.8,GMRAI,0)),U)
if '+PAT
QUIT
+6 ;Not the one we're looking for
if $PIECE($GET(^GMR(120.8,GMRAI,0)),U,3)'=GMRAIODN
QUIT
+7 ;Stop if entered in error or patient has expired
if $DATA(^GMR(120.8,GMRAI,"ER"))!($$DECEASED^GMRAFX(PAT))
QUIT
+8 SET GMRAPA=GMRAI
+9 ;Update allergy type to drug
SET DIE="^GMR(120.8,"
SET DA=GMRAPA
SET DR="3.1////D"
DO ^DIE
+10 ;Delete any existing ingredients and drug classes for this allergy
DO DELMUL^GMRAFX3(2)
DO DELMUL^GMRAFX3(3)
+11 ;add ingredients and drug classes from IODINE entry
DO UPDATE^GMRAPES1
+12 SET GMRAIOD(PAT)=""
+13 QUIT
End DoDot:1
+14 QUIT
+15 ;
ADDB ;Add B xref to reactions multiple in 120.85
+1 NEW IEN,DA,DIK
+2 SET IEN=0
FOR
SET IEN=$ORDER(^GMR(120.85,IEN))
if '+IEN
QUIT
IF $DATA(^GMR(120.85,IEN,2))
Begin DoDot:1
+3 SET $PIECE(^GMR(120.85,IEN,2,0),U,2)="120.8502P"
+4 SET DA(1)=IEN
SET DIK="^GMR(120.85,DA(1),2,"
DO IXALL^DIK
End DoDot:1
+5 QUIT
