VistA-WorldVistAEHR/r/ADVERSE_REACTION_TRACKING-G.../GMRAIAL2.m

143 lines
6.2 KiB
Mathematica
Raw Permalink Normal View History

2009-11-29 13:37:14 -05:00
GMRAIAL2 ;BPOIFO/JG - BUILD HL7 ORU^R01 MESSAGE FOR ALLERGIES - PART 2 ; 17 Mar 2006 11:55 AM
;;4.0;Adverse Reaction Tracking;**22,23,34**;Mar 29, 1996
; Creates HL7 V2.4 ORU^R01 message for allergy updates & assessments
;
; This routine uses the following IAs:
; #4248 - VDEFEL calls (controlled)
; #3630 - VAFCQRY calls (controlled)
; #4531 - ZERO^PSN50P41 (supported)
; #2574 - $$CLASS2^PSNAPIS (supported)
;
; This routine is called as a subroutine by GMRAIAL1
;
Q
;
ENTRY ; Entry point from GMRAIAL1
;
; Skip to OBX8 if doing an assessment
G OBX8:ALTYPE=2
;
; OBX 1 - Reactant
OBX1 S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"AGENT"_HLFS
S $P(OUTX,HLFS,5)=$$HL7RC^GMRAIAL1($P(ALRDATA,U,2)),$P(OUTX,HLFS,11)=RSLTSTA
S X=$P(SITEPARM,U,6)_HLCM_$P(SITEPARM,U,5)_HLCM_"L",$P(OUTX,HLFS,15)=X
S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
;
; OBX2 - Allergy Type
OBX2 S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"ALLERGY TYPE"_HLFS
S X=$P(ALRDATA,U,20),VAL=X_HLCM F I=1:1:$L(X) D
. S Y=$E(X,I),Y=$S(Y="D":"DRUG",Y="F":"FOOD",Y="O":"OTHER",1:"")
. S VAL=VAL_Y S:I<$L(X) VAL=VAL_","
S VAL=VAL_HLCM_"L",$P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)=RSLTSTA
S X=$P(SITEPARM,U,6)_HLCM_$P(SITEPARM,U,5)_HLCM_"L",$P(OUTX,HLFS,15)=X
S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
;
; OBX3 - GMR Allergy
; ALLERGIES FROM VA DRUG CLASS HAVE SPECIAL FORMAT FOR
; OBX-5
OBX3 S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"GMR ALLERGY"_HLFS
S VAL="",X=$P(ALRDATA,U,3) G OBX4:X=""
I X'["50.605" D
. S VAL=$P($G(@("^"_$P(X,";",2)_$P(X,";",1)_",0)")),U)
. I VAL="" D ERR^VDEFREQ("No data in GMR Allergy file "_$P(X,";",2)_$P(X,";")_",0)") S ZTSTOP=1 Q
. I X["PSDRUG" S GMRAVUID=$P(X,";",1)_U_$P(SITEPARM,U,6)_"_"_50
. E D
. . S GMRAFILE=+$P($P(X,";",2),"(",2),GMRAIENS=+X_","
. . S GMRAVUID=$$GETVUID^GMRAIAL1(GMRAFILE,.01,GMRAIENS,1)
. S VAL=$P(GMRAVUID,U)_HLCM_VAL_HLCM_$P(GMRAVUID,U,2)
I X["50.605" D
. S GMRAIENS=$P(X,";"),Y=$$CLASS2^PSNAPIS(GMRAIENS)
. S GMRAVUID=$$GETVUID^GMRAIAL1(50.605,.01,GMRAIENS_",",1)
. 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"
G RETURN:ZTSTOP
S $P(VAL,HLCM,2)=$$HL7RC^GMRAIAL1($P(VAL,HLCM,2)),$P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)=RSLTSTA ;34
S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
;
; OBX4 - List of drug ingredients
OBX4 G OBX5:'$D(^GMR(120.8,KEY,2))
S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"DRUG INGREDIENTS"_HLFS
S IEN1=0,VAL="" F S IEN1=$O(^GMR(120.8,KEY,2,IEN1)) Q:'+IEN1 D
. S Y=^GMR(120.8,KEY,2,IEN1,0),GMRAVUID=$$GETVUID^GMRAIAL1(50.416,.01,Y_",",1)
. D ZERO^PSN50P41(Y,,,"GMRAING") ;34 Gets zero node of ingredient entry from 50.416
. 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
S VAL=$E(VAL,1,$L(VAL)-1),$P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)=RSLTSTA
S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
;
; OBX5 - Drug class
OBX5 G OBX6:'$D(^GMR(120.8,KEY,3))
S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"DRUG CLASSES"_HLFS
S IEN1=0,VAL="" F S IEN1=$O(^GMR(120.8,KEY,3,IEN1)) Q:'+IEN1 D
. S GMRAIENS=^GMR(120.8,KEY,3,IEN1,0),X=$$CLASS2^PSNAPIS(GMRAIENS)
. S GMRAVUID=$$GETVUID^GMRAIAL1(50.605,.01,GMRAIENS_",",1)
. 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
S VAL=$E(VAL,1,$L(VAL)-1),$P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)=RSLTSTA
S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
;
; OBX6 - MECHANISM
OBX6 S X=$P(ALRDATA,U,14) G OBX7:X=""
S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"MECHANISM"_HLFS
S GMRAVUID=$$GETVUID^GMRAIAL1(120.8,17,X)
S VAL=$P(GMRAVUID,U)_HLCM_$S(X="A":"ALLERGY",X="P":"PHARMACOLOGIC",X="U":"UNKNOWN",1:"")_HLCM_$P(GMRAVUID,U,2)
S $P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)=RSLTSTA
S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
;
; OBX7 - Reaction
OBX7 S IEN1=0 F S IEN1=$O(^GMR(120.8,KEY,10,IEN1)) Q:'+IEN1 D Q:ZTSTOP
. S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"REACTION"_HLFS
. S X=^GMR(120.8,KEY,10,IEN1,0),GMRAVUID=""
. S:$P(X,U,2)'="" GMRAVUID="^L"
. S:$P(X,U,2)="" $P(X,U,2)=$P($G(^GMRD(120.83,+X,0)),U)
. S:GMRAVUID'="^L" GMRAVUID=$$GETVUID^GMRAIAL1(120.83,.01,+X_",",1)
. S VAL=$P(GMRAVUID,U)_HLCM_$$HL7RC^GMRAIAL1($P(X,U,2))_HLCM_$P(GMRAVUID,U,2) ;34
. S $P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)=RSLTSTA
. S $P(OUTX,HLFS,14)=$$TS^VDEFEL($P(X,U,4))
. S XX=$$XCN200^VDEFEL($P(X,U,3)) ;34
. F II=2:1:7 S $P(XX,SEPC,II)=$$HL7RC^GMRAIAL1($P(XX,SEPC,II)) ;34
. S $P(OUTX,HLFS,16)=XX ;34
. S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
;
; Skip assessment if allergy update
G OBX9:ALTYPE=1
;
; OBX8 - Assessment
OBX8 S S=S+1,OUTX=1_HLFS_"CE"_HLFS_"ASSESSMENT"_HLFS
I +ENTERR=1 S VAL=HLCM_"ENTERED IN ERROR"_HLCM G OBX8A ;34
S X=+$P(ALRDATA,U,2),GMRAVUID=$$GETVUID^GMRAIAL1(120.86,1,X)
S VAL=$P(GMRAVUID,U)_HLCM_$S(X=0:"NO KNOWN ALLERGIES",X=1:"YES",1:"")
S VAL=VAL_HLCM_$P(GMRAVUID,U,2)
OBX8A S $P(OUTX,HLFS,5)=VAL,$P(OUTX,HLFS,11)=$E("FW",1+ENTERR) ;34
I '+ENTERR S $P(OUTX,HLFS,14)=$$TS^VDEFEL($P(ALRDATA,U,4))
I '+ENTERR D ;Block added in 34
. S XX=$$XCN200^VDEFEL($P(ALRDATA,U,3))
. F II=2:1:7 S $P(XX,SEPC,II)=$$HL7RC^GMRAIAL1($P(XX,SEPC,II))
. S $P(OUTX,HLFS,16)=XX
S OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
;
; Done if assessment
G RETURN:ALTYPE=2
;
; OBX9 - Comments
; One OBX for each comment
OBX9 S IEN=0 F S IEN=$O(^GMR(120.8,KEY,26,IEN)) Q:'+IEN D
. S ALRDATA=$G(^GMR(120.8,KEY,26,IEN,0)) G RETURN:ALRDATA=""
. ; Set up the static fields
. S X1=1_HLFS_"TX"_HLFS_"COMMENT"_HLFS
. S XX=$$XCN200^VDEFEL($P(ALRDATA,U,2)) ;34
. F II=2:1:7 S $P(XX,SEPC,II)=$$HL7RC^GMRAIAL1($P(XX,SEPC,II)) ;34
. S $P(X1,HLFS,11)=RSLTSTA,$P(X1,HLFS,16)=XX ;34
. S $P(X1,HLFS,19)=$$TS^VDEFEL($P(ALRDATA,U)),X=$P(ALRDATA,U,3)
. S GMRAVUID=$$GETVUID^GMRAIAL1(120.826,1.5,X)
. S $P(X,HLCM,2)=$S(X="V":"VERIFIED",X="O":"OBSERVED",X="E":"ERRORED",1:"")
. S $P(X,HLCM)=+GMRAVUID,$P(X,HLCM,3)=$P(GMRAVUID,U,2)
. S $P(X1,HLFS,17)=X
. ;
. ; A comment may be more than one line
. S IEN1=0,VAL="" F S IEN1=$O(^GMR(120.8,KEY,26,IEN,2,IEN1)) Q:'+IEN1 D
. . S X=$$HL7RC^GMRAIAL1(^GMR(120.8,KEY,26,IEN,2,IEN1,0)),VAL=VAL_X_HLRP
. S:$E(VAL,$L(VAL))=HLRP VAL=$E(VAL,1,$L(VAL)-1)
. S OUTX=X1,$P(OUTX,HLFS,5)=VAL
. S S=S+1,OUTX="OBX"_HLFS_OUTX D SAVE^GMRAIAL1
;
; Return to GMRAIAL1
RETURN Q