| 1 | GMRAPES1 ;HIRMFO/RM,WAA-SELECT PATIENT ALLERGY TO EDIT ;7/28/03  15:23
 | 
|---|
| 2 |  ;;4.0;Adverse Reaction Tracking;**13,14,17**;Mar 29, 1996
 | 
|---|
| 3 | ADAR ; ADD A NEW A/AR FOR THIS PATIENT
 | 
|---|
| 4 |  S GMRAPA="" F X=0:0 S X=$O(^GMR(120.8,"B",DFN,X)) Q:X'>0  I $S('$D(^GMR(120.8,X,0)):0,$P(^(0),"^",2)=GMRAAR(0):1,1:0),$S('$D(^("ER")):1,1:'+^("ER")) S GMRAPA=X Q
 | 
|---|
| 5 |  Q:GMRAPA>0
 | 
|---|
| 6 |  I $D(XRTL) D T0^%ZOSV ; START RT
 | 
|---|
| 7 |  D NOW^%DTC
 | 
|---|
| 8 |  S GMRAAR(1)=+$E(%,1,12),DIC="^GMR(120.8,",DIC(0)="LQ",DLAYGO=120.8
 | 
|---|
| 9 |  S DIC("DR")=".02////"_GMRAAR(0)_";1////^S X=GMRAAR;4////"_GMRAAR(1)_";5////"_DUZ_";15///0;17///U;3.1////"_$S($G(GMRAAR("O"))'="":GMRAAR("O"),1:"O"),X=DFN
 | 
|---|
| 10 |  K DD,DO D FILE^DICN
 | 
|---|
| 11 |  K DIC,DLAYGO S GMRAPA=+Y,GMRANEW=Y>0
 | 
|---|
| 12 |  S GMRACAUS="RADIOLOGICAL/CONTRAST MEDIA",GMRADRCL=$O(^PS(50.605,"B","DX100",0))_";PS(50.605,"
 | 
|---|
| 13 |  K GMRACAUS,GMRADRCL
 | 
|---|
| 14 |  I GMRAPA'>0 D  Q  ;Entry is not added
 | 
|---|
| 15 |  .   I $D(XRT0) S XRTN=$T(+0) D T1^%ZOSV ; STOP RT IF EXITING HERE
 | 
|---|
| 16 |  .   Q
 | 
|---|
| 17 |  ;
 | 
|---|
| 18 | UPDATE ;Updates entry with drug ingredients and/or drug classes - this API added with patch 17
 | 
|---|
| 19 |  ;Start of New code to support Drug Classes
 | 
|---|
| 20 |  ;This code section will auto stuff Ings and VA Drug Classes
 | 
|---|
| 21 |  ;GMRAING() will have all the Ing for the selected reaction
 | 
|---|
| 22 |  ;GMRADRCL() will have all the drug classes for the selected
 | 
|---|
| 23 |  ;reaction.
 | 
|---|
| 24 |  ;If the Reactant is a Drug Ingrediant
 | 
|---|
| 25 |  I GMRAAR[50.416 S GMRAING(+GMRAAR)="" G STING
 | 
|---|
| 26 |  ;If the Reacant is a Drug Class
 | 
|---|
| 27 |  I GMRAAR[50.605 S GMRADRCL(+GMRAAR)=""
 | 
|---|
| 28 |  ;If the Reactant is a entry in the GMR ALLERGY file
 | 
|---|
| 29 |  I GMRAAR[120.82 D
 | 
|---|
| 30 |  .S Y=0 F  S Y=$O(^GMRD(120.82,+GMRAAR,"ING",Y)) Q:Y'>0  I $D(^GMRD(120.82,+GMRAAR,"ING",Y,0)),+^(0)>0 S GMRAING(+^(0))=""
 | 
|---|
| 31 |  .S Y=0 F  S Y=$O(^GMRD(120.82,+GMRAAR,"CLASS",Y)) Q:Y'>0  I $D(^GMRD(120.82,+GMRAAR,"CLASS",Y,0)),+^(0)>0 S GMRADRCL(+^(0))=""
 | 
|---|
| 32 |  .Q
 | 
|---|
| 33 |  I GMRAAR["PSDRUG" D
 | 
|---|
| 34 |  .N PSODA
 | 
|---|
| 35 |  .S PSODA=+GMRAAR K ^TMP("PSO",$J) D ^PSONGR F Y=0:0 S Y=$O(^TMP("PSO",$J,Y)) Q:Y'>0  S GMRAING(Y)=""
 | 
|---|
| 36 |  .N GMRAX,GMRAY
 | 
|---|
| 37 |  .S GMRAX=$P($G(^PSDRUG(+GMRAAR,"ND")),U,6) S:GMRAX>0 GMRADRCL(GMRAX)="" Q
 | 
|---|
| 38 |  .S GMRAX=$P($G(^PSDRUG(+GMRAAR,0)),U,2) Q:GMRAX=""
 | 
|---|
| 39 |  .S GMRAY=$O(^PS(50.605,"B",GMRAX,"")) S:GMRAY>0 GMRADRCL(GMRAY)=""
 | 
|---|
| 40 |  .Q
 | 
|---|
| 41 |  I GMRAAR["PSNDF" D
 | 
|---|
| 42 |  .N PSNDA
 | 
|---|
| 43 |  .S PSNDA=+GMRAAR K ^TMP("PSN",$J) D ^PSNNGR F Y=0:0 S Y=$O(^TMP("PSN",$J,Y)) Q:Y'>0  S GMRAING(Y)=""
 | 
|---|
| 44 |  .; all classes for NDF entry returned in GMRADRCL
 | 
|---|
| 45 |  .N CLASS
 | 
|---|
| 46 |  .S CLASS=$$CLIST^PSNAPIS(+GMRAAR,.GMRADRCL)
 | 
|---|
| 47 |  .Q
 | 
|---|
| 48 |  K ^TMP("PSO",$J),^TMP("PSN",$J),PSOID,PSNID
 | 
|---|
| 49 | STING ;Stuffing Drug Ing & VA Drug Classes into file 120.8
 | 
|---|
| 50 |  I $D(GMRAING) D
 | 
|---|
| 51 |  .S DA(1)=+GMRAPA,DIC="^GMR(120.8,"_+GMRAPA_",2,",DLAYGO=120.8,DIC(0)="L",DIC("P")="120.802PA"
 | 
|---|
| 52 |  .F X=0:0 S X=$O(GMRAING(X)) Q:X'>0  I '$D(^GMR(120.8,GMRAPA,2,"B",X)) K DD,DO,DINUM D FILE^DICN
 | 
|---|
| 53 |  .K DIC,DLAYGO
 | 
|---|
| 54 |  .Q
 | 
|---|
| 55 |  I $D(GMRADRCL) D
 | 
|---|
| 56 |  .S DA(1)=+GMRAPA,DIC="^GMR(120.8,"_+GMRAPA_",3,",DIC(0)="L",DIC("P")="120.803PA"
 | 
|---|
| 57 |  .F X=0:0 S X=$O(GMRADRCL(X)) Q:X'>0  I '$D(^GMR(120.8,GMRAPA,3,"B",X)) K DD,DO,DINUM D FILE^DICN
 | 
|---|
| 58 |  .K DIC
 | 
|---|
| 59 |  .Q
 | 
|---|
| 60 |  I $D(XRT0) S XRTN=$T(+0) D T1^%ZOSV ; STOP RT IF EXITING HERE
 | 
|---|
| 61 |  K GMRADRCL,GMRAING
 | 
|---|
| 62 |  Q
 | 
|---|