source: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPES1.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
RevLine 
[613]1GMRAPES1 ;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
3ADAR ; 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 ;
18UPDATE ;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
49STING ;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
Note: See TracBrowser for help on using the repository browser.