source: FOIAVistA/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAIAL2.m@ 635

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

initial load of FOIAVistA 6/30/08 version
File size: 6.2 KB
Line 
1GMRAIAL2 ;BPOIFO/JG - BUILD HL7 ORU^R01 MESSAGE FOR ALLERGIES - PART 2 ; 17 Mar 2006 11:55 AM
2 ;;4.0;Adverse Reaction Tracking;**22,23,34**;Mar 29, 1996
3 ; Creates HL7 V2.4 ORU^R01 message for allergy updates & assessments
4 ;
5 ; This routine uses the following IAs:
6 ; #4248 - VDEFEL calls (controlled)
7 ; #3630 - VAFCQRY calls (controlled)
8 ; #4531 - ZERO^PSN50P41 (supported)
9 ; #2574 - $$CLASS2^PSNAPIS (supported)
10 ;
11 ; This routine is called as a subroutine by GMRAIAL1
12 ;
13 Q
14 ;
15ENTRY ; Entry point from GMRAIAL1
16 ;
17 ; Skip to OBX8 if doing an assessment
18 G OBX8:ALTYPE=2
19 ;
20 ; OBX 1 - Reactant
21OBX1 S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"AGENT"_HLFS
22 S $P(OUTX,HLFS,5)=$$HL7RC^GMRAIAL1($P(ALRDATA,U,2)),$P(OUTX,HLFS,11)=RSLTSTA
23 S X=$P(SITEPARM,U,6)_HLCM_$P(SITEPARM,U,5)_HLCM_"L",$P(OUTX,HLFS,15)=X
24 S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
25 ;
26 ; OBX2 - Allergy Type
27OBX2 S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"ALLERGY TYPE"_HLFS
28 S X=$P(ALRDATA,U,20),VAL=X_HLCM F I=1:1:$L(X) D
29 . S Y=$E(X,I),Y=$S(Y="D":"DRUG",Y="F":"FOOD",Y="O":"OTHER",1:"")
30 . S VAL=VAL_Y S:I<$L(X) VAL=VAL_","
31 S VAL=VAL_HLCM_"L",$P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)=RSLTSTA
32 S X=$P(SITEPARM,U,6)_HLCM_$P(SITEPARM,U,5)_HLCM_"L",$P(OUTX,HLFS,15)=X
33 S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
34 ;
35 ; OBX3 - GMR Allergy
36 ; ALLERGIES FROM VA DRUG CLASS HAVE SPECIAL FORMAT FOR
37 ; OBX-5
38OBX3 S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"GMR ALLERGY"_HLFS
39 S VAL="",X=$P(ALRDATA,U,3) G OBX4:X=""
40 I X'["50.605" D
41 . S VAL=$P($G(@("^"_$P(X,";",2)_$P(X,";",1)_",0)")),U)
42 . I VAL="" D ERR^VDEFREQ("No data in GMR Allergy file "_$P(X,";",2)_$P(X,";")_",0)") S ZTSTOP=1 Q
43 . I X["PSDRUG" S GMRAVUID=$P(X,";",1)_U_$P(SITEPARM,U,6)_"_"_50
44 . E D
45 . . S GMRAFILE=+$P($P(X,";",2),"(",2),GMRAIENS=+X_","
46 . . S GMRAVUID=$$GETVUID^GMRAIAL1(GMRAFILE,.01,GMRAIENS,1)
47 . S VAL=$P(GMRAVUID,U)_HLCM_VAL_HLCM_$P(GMRAVUID,U,2)
48 I X["50.605" D
49 . S GMRAIENS=$P(X,";"),Y=$$CLASS2^PSNAPIS(GMRAIENS)
50 . S GMRAVUID=$$GETVUID^GMRAIAL1(50.605,.01,GMRAIENS_",",1)
51 . S VAL=$G(VAL)_$P(GMRAVUID,U)_HLCM_$P(Y,U,2)_HLCM_$P(GMRAVUID,U,2)_HLCM_$P(Y,U)_HLCM_$P(Y,U,2)_HLCM_$P(SITEPARM,U,6)_"_50.605"
52 G RETURN:ZTSTOP
53 S $P(VAL,HLCM,2)=$$HL7RC^GMRAIAL1($P(VAL,HLCM,2)),$P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)=RSLTSTA ;34
54 S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
55 ;
56 ; OBX4 - List of drug ingredients
57OBX4 G OBX5:'$D(^GMR(120.8,KEY,2))
58 S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"DRUG INGREDIENTS"_HLFS
59 S IEN1=0,VAL="" F S IEN1=$O(^GMR(120.8,KEY,2,IEN1)) Q:'+IEN1 D
60 . S Y=^GMR(120.8,KEY,2,IEN1,0),GMRAVUID=$$GETVUID^GMRAIAL1(50.416,.01,Y_",",1)
61 . D ZERO^PSN50P41(Y,,,"GMRAING") ;34 Gets zero node of ingredient entry from 50.416
62 . S X=$P(GMRAVUID,U)_HLCM_$$HL7RC^GMRAIAL1($P(^TMP($J,"GMRAING",Y,.01),U))_HLCM_$P(GMRAVUID,U,2),VAL=VAL_X_HLRP ;34
63 S VAL=$E(VAL,1,$L(VAL)-1),$P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)=RSLTSTA
64 S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
65 ;
66 ; OBX5 - Drug class
67OBX5 G OBX6:'$D(^GMR(120.8,KEY,3))
68 S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"DRUG CLASSES"_HLFS
69 S IEN1=0,VAL="" F S IEN1=$O(^GMR(120.8,KEY,3,IEN1)) Q:'+IEN1 D
70 . S GMRAIENS=^GMR(120.8,KEY,3,IEN1,0),X=$$CLASS2^PSNAPIS(GMRAIENS)
71 . S GMRAVUID=$$GETVUID^GMRAIAL1(50.605,.01,GMRAIENS_",",1)
72 . S VAL=$G(VAL)_$P(GMRAVUID,U)_HLCM_$$HL7RC^GMRAIAL1($P(X,U,2))_HLCM_$P(GMRAVUID,U,2)_HLCM_$P(X,U)_HLCM_$$HL7RC^GMRAIAL1($P(X,U,2))_HLCM_$P(SITEPARM,U,6)_"_50.605"_HLRP ;34
73 S VAL=$E(VAL,1,$L(VAL)-1),$P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)=RSLTSTA
74 S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
75 ;
76 ; OBX6 - MECHANISM
77OBX6 S X=$P(ALRDATA,U,14) G OBX7:X=""
78 S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"MECHANISM"_HLFS
79 S GMRAVUID=$$GETVUID^GMRAIAL1(120.8,17,X)
80 S VAL=$P(GMRAVUID,U)_HLCM_$S(X="A":"ALLERGY",X="P":"PHARMACOLOGIC",X="U":"UNKNOWN",1:"")_HLCM_$P(GMRAVUID,U,2)
81 S $P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)=RSLTSTA
82 S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
83 ;
84 ; OBX7 - Reaction
85OBX7 S IEN1=0 F S IEN1=$O(^GMR(120.8,KEY,10,IEN1)) Q:'+IEN1 D Q:ZTSTOP
86 . S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"REACTION"_HLFS
87 . S X=^GMR(120.8,KEY,10,IEN1,0),GMRAVUID=""
88 . S:$P(X,U,2)'="" GMRAVUID="^L"
89 . S:$P(X,U,2)="" $P(X,U,2)=$P($G(^GMRD(120.83,+X,0)),U)
90 . S:GMRAVUID'="^L" GMRAVUID=$$GETVUID^GMRAIAL1(120.83,.01,+X_",",1)
91 . S VAL=$P(GMRAVUID,U)_HLCM_$$HL7RC^GMRAIAL1($P(X,U,2))_HLCM_$P(GMRAVUID,U,2) ;34
92 . S $P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)=RSLTSTA
93 . S $P(OUTX,HLFS,14)=$$TS^VDEFEL($P(X,U,4))
94 . S XX=$$XCN200^VDEFEL($P(X,U,3)) ;34
95 . F II=2:1:7 S $P(XX,SEPC,II)=$$HL7RC^GMRAIAL1($P(XX,SEPC,II)) ;34
96 . S $P(OUTX,HLFS,16)=XX ;34
97 . S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
98 ;
99 ; Skip assessment if allergy update
100 G OBX9:ALTYPE=1
101 ;
102 ; OBX8 - Assessment
103OBX8 S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"ASSESSMENT"_HLFS
104 I +ENTERR=1 S VAL=HLCM_"ENTERED IN ERROR"_HLCM G OBX8A ;34
105 S X=+$P(ALRDATA,U,2),GMRAVUID=$$GETVUID^GMRAIAL1(120.86,1,X)
106 S VAL=$P(GMRAVUID,U)_HLCM_$S(X=0:"NO KNOWN ALLERGIES",X=1:"YES",1:"")
107 S VAL=VAL_HLCM_$P(GMRAVUID,U,2)
108OBX8A S $P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)=$E("FW",1+ENTERR) ;34
109 I '+ENTERR S $P(OUTX,HLFS,14)=$$TS^VDEFEL($P(ALRDATA,U,4))
110 I '+ENTERR D ;Block added in 34
111 . S XX=$$XCN200^VDEFEL($P(ALRDATA,U,3))
112 . F II=2:1:7 S $P(XX,SEPC,II)=$$HL7RC^GMRAIAL1($P(XX,SEPC,II))
113 . S $P(OUTX,HLFS,16)=XX
114 S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
115 ;
116 ; Done if assessment
117 G RETURN:ALTYPE=2
118 ;
119 ; OBX9 - Comments
120 ; One OBX for each comment
121OBX9 S IEN=0 F S IEN=$O(^GMR(120.8,KEY,26,IEN)) Q:'+IEN D
122 . S ALRDATA=$G(^GMR(120.8,KEY,26,IEN,0)) G RETURN:ALRDATA=""
123 . ; Set up the static fields
124 . S X1=1_HLFS_"TX"_HLFS_"COMMENT"_HLFS
125 . S XX=$$XCN200^VDEFEL($P(ALRDATA,U,2)) ;34
126 . F II=2:1:7 S $P(XX,SEPC,II)=$$HL7RC^GMRAIAL1($P(XX,SEPC,II)) ;34
127 . S $P(X1,HLFS,11)=RSLTSTA,$P(X1,HLFS,16)=XX ;34
128 . S $P(X1,HLFS,19)=$$TS^VDEFEL($P(ALRDATA,U)),X=$P(ALRDATA,U,3)
129 . S GMRAVUID=$$GETVUID^GMRAIAL1(120.826,1.5,X)
130 . S $P(X,HLCM,2)=$S(X="V":"VERIFIED",X="O":"OBSERVED",X="E":"ERRORED",1:"")
131 . S $P(X,HLCM)=+GMRAVUID,$P(X,HLCM,3)=$P(GMRAVUID,U,2)
132 . S $P(X1,HLFS,17)=X
133 . ;
134 . ; A comment may be more than one line
135 . S IEN1=0,VAL="" F S IEN1=$O(^GMR(120.8,KEY,26,IEN,2,IEN1)) Q:'+IEN1 D
136 . . S X=$$HL7RC^GMRAIAL1(^GMR(120.8,KEY,26,IEN,2,IEN1,0)),VAL=VAL_X_HLRP
137 . S:$E(VAL,$L(VAL))=HLRP VAL=$E(VAL,1,$L(VAL)-1)
138 . S OUTX=X1,$P(OUTX,HLFS,5)=VAL
139 . S S=S+1,OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
140 ;
141 ; Return to GMRAIAL1
142RETURN Q
Note: See TracBrowser for help on using the repository browser.