- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORQQAL.m
r613 r623 1 ORQQAL ; slc/CLA,JFR - Functions which return patient allergy data ;6/8/06 14:11 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,85,162,190,216,232,243**;Dec 17, 1997;Build 242 3 LIST(ORAY,ORPT) ; RETURN PATIENT'S ALLERGY/ADVERSE REACTION INFO: 4 ; null:no allergy assessment, 0:no known allergies, 1:pt has allergies 5 ; if 1 also get: allergen/reactant^reaction/symptom^severity^allergy ien 6 N I,J,K 7 S I=1,J=0,K=0 8 D EN1^GMRAOR1(ORPT,"GMRARXN") 9 I $G(GMRARXN)="" S ORAY(I)="^No Allergy Assessment" 10 I $G(GMRARXN)=0 S ORAY(I)="^No Known Allergies" 11 I $G(GMRARXN)=1 F S J=$O(GMRARXN(J)) Q:J="" S ORAY(I)=$P(GMRARXN(J),"^",3)_"^"_$P(GMRARXN(J),"^")_"^"_$P(GMRARXN(J),"^",2) D SIGNS S I=I+1 12 S:'$D(ORAY(1)) ORAY(1)="^No allergies found." 13 K GMRARXN 14 Q 15 SIGNS S K=0,N=0 F S K=$O(GMRARXN(J,"S",K)) Q:K'>0 D 16 .I N=0 S ORAY(I)=ORAY(I)_"^"_$P(GMRARXN(J,"S",K),";") 17 .E S ORAY(I)=ORAY(I)_";"_$P(GMRARXN(J,"S",K),";") 18 .S N=N+1 19 Q 20 LRPT(ORAY,ORPT) ; RETURN PT'S ALLERGY/ADVERSE REACTION INFO IN REPORT FORMAT: 21 ; null:no allergy assessment, 0:no known allergies, 1:pt has allergies 22 ; if 1 also get: allergen/reactant^reaction/symptom^severity^allergy ien 23 N I,J,K,SEVER,CR,GMRAIDT ;216 24 S CR=$CHAR(13) 25 S I=1,J=0,K=0,SEVER="",GMRAIDT=1 ;216 26 D EN1^GMRAOR1(ORPT,"GMRARXN") 27 I $G(GMRARXN)="" S ORAY(I)="No Allergy Assessment" 28 I $G(GMRARXN)=0 S ORAY(I)="No Known Allergies" 29 I $G(GMRARXN)=1 F S J=$O(GMRARXN(J)) Q:J="" D 30 .S SEVER=$P(GMRARXN(J),U,2) 31 .S ORAY(I)=$P(GMRARXN(J),U)_" "_$S($L($G(SEVER)):"[Severity: "_SEVER_"]",1:""),I=I+1 32 .S K=0,N=0 F S K=$O(GMRARXN(J,"S",K)) Q:K'>0 D 33 ..I N=0 S ORAY(I)=" Signs/symptoms: "_$P(GMRARXN(J,"S",K),";") 34 ..E S ORAY(I)=" "_$P(GMRARXN(J,"S",K),";") 35 ..I $P(GMRARXN(J,"S",K),";",2) S ORAY(I)=ORAY(I)_" ("_$$FMTE^XLFDT($P(GMRARXN(J,"S",K),";",2),2)_")" ;216 36 ..S N=N+1,I=I+1 37 .S ORAY(I)=" ",I=I+1 38 S:'$D(ORAY(1)) ORAY(1)="No allergies found." 39 K GMRARXN 40 Q 41 RXN(ORAY,ORPT,SRC,NDF,PSDRUG) ; RETURN TRUE OR FALSE IF PATIENT IS ALLERGIC TO AGENT 42 ; SRC: ALLERGEN SOURCE (CM=CONTRAST MEDIA, DR=DRUG) 43 ; NDF: IF SRC=DR, NDF=Nat'l Drug File ien ELSE NDF="" 44 ; PSDRUG:IF SRC=DR, PSDRUG=(local) Drug file ien ELSE PSDRUG="" 45 S ORAY=$$ORCHK^GMRAOR(ORPT,SRC,NDF) 46 I SRC="DR",ORAY=1 D ;drug ingredient allergy found 47 .S I=1,J=0 F S J=$O(GMRAING(J)) Q:J="" D 48 ..I I=1 S ORAY=ORAY_U_GMRAING(J) 49 ..E S ORAY=ORAY_";"_GMRAING(J) 50 ..S I=I+1 51 I SRC="DR",ORAY=2 D ;drug class allergy found 52 .S CL="",I=1,J=0 F S J=$O(GMRADRCL(J)) Q:J="" D 53 ..; per test sites 3/17/04 - no oc for pt allergy to entire HERBS class: 54 ..Q:$P(GMRADRCL(J),U)="HA000" 55 ..I I=1 S ORAY=ORAY_U_$P(GMRADRCL(J),U,2) 56 ..E S CL=$P(GMRADRCL(J),U,2) I ORAY'[CL S ORAY=ORAY_";"_CL 57 ..S I=I+1 58 I SRC="DR",(+$G(ORAY)<1) D MEDCLASS(.ORAY,ORPT,PSDRUG) 59 K I,J,GMRADRCL,GMRAING,CL 60 Q 61 MEDCLASS(ORAY,DFN,PSDRUG) ;check for allergens with medications in same VA drug class 62 N ORVACLS,CL,X,I,RET,TYP 63 S TYP="DR" 64 Q:+$G(PSDRUG)<1 65 ;S ORVACLS=$P(^PSDRUG(PSDRUG,0),U,2) 66 S ORVACLS=$$CLASS50^ORPEAPI(PSDRUG) 67 Q:$L(ORVACLS)<4 68 Q:$G(ORVACLS)="HA000" ;don't process herbal drug class for order checks 69 S CL=$S($E(ORVACLS,1,4)="CN10":5,1:4) ;look at 5 chars if ANALGESICS 70 D GETDATA^GMRAOR(DFN) 71 Q:'$D(^TMP("GMRAOC",$J,"APC")) 72 S I="" F S I=$O(^TMP("GMRAOC",$J,"APC",I)) Q:'$L(I) D 73 .I $E(I,1,CL)=$E(ORVACLS,1,CL) S X=I 74 I $L($G(X)) D 75 .N IEN,NAME 76 .D IEN^PSN50P65(,X,"ORQQAL") 77 .S IEN=$O(^TMP($J,"ORQQAL","B",X,0)) 78 .I 'IEN S ORAY="2"_U_X Q 79 .S NAME=$G(^TMP($J,"ORQQAL",IEN,1)) 80 .I '$L(NAME) S ORAY="2"_U_X Q 81 .S ORAY="2"_U_NAME_": ("_$G(^TMP("GMRAOC",$J,"APC",X))_")" 82 K ^TMP("GMRAOC",$J) 83 Q 84 DETAIL(ORAY,DFN,ALLR,ID) ; RETURN DETAILED ALLERGY INFO FOR SPECIFIED ALLERGIC REACTION: 85 D EN1^GMRAOR2(ALLR,"GMRACT") 86 N CR,OX,OH S CR=$CHAR(13),I=1 87 S ORAY(I)=" Causative agent: "_$P(GMRACT,U),I=I+1 88 S ORAY(I)=" Nature of Reaction: "_$S($P(GMRACT,U,6)="ALLERGY":"Allergy",$P(GMRACT,U,6)="PHARMACOLOGIC":"Adverse Reaction",$P(GMRACT,U,6)="UNKNOWN":"Unknown",1:""),I=I+1 ;216 89 S ORAY(I)=" ",I=I+1 90 I $D(GMRACT("S",1)) D SYMP 91 I $D(GMRACT("V",1)) D CLAS 92 S ORAY(I)=" Originator: "_$P(GMRACT,U,2)_$S($L($P(GMRACT,U,3)):" ("_$P(GMRACT,U,3)_")",1:""),I=I+1 ;216 93 S ORAY(I)=" Originated: "_$P(GMRACT,U,10),I=I+1 ;216 94 I $D(GMRACT("O",1)) D OBS 95 S ORAY(I)=" Verified: "_$S($P(GMRACT,U,4)="VERIFIED":$P(GMRACT,U,8),1:"No"),I=I+1 ;216 96 S ORAY(I)="Observed/Historical: "_$S($P(GMRACT,U,5)="OBSERVED":"Observed",$P(GMRACT,U,5)="HISTORICAL":"Historical",1:""),I=I+1 97 I $D(GMRACT("C",1)) D COM 98 K GMRACT 99 Q 100 SYMP S K=0,N=0 F S K=$O(GMRACT("S",K)) Q:K'>0 D 101 .I N=0 S ORAY(I)=" Signs/symptoms: "_GMRACT("S",K),I=I+1 102 .E S ORAY(I)=" "_GMRACT("S",K),I=I+1 103 .S N=N+1 104 S ORAY(I)=" ",I=I+1 105 K N,K 106 Q 107 CLAS S K=0,N=0 F S K=$O(GMRACT("V",K)) Q:K'>0 D 108 .I N=0 S ORAY(I)=" Drug Classes: "_$P(GMRACT("V",K),U,2),I=I+1 109 .E S ORAY(I)=" "_$P(GMRACT("V",K),U,2),I=I+1 110 .S N=N+1 111 S ORAY(I)=" ",I=I+1 112 K N,K 113 Q 114 OBS S K=0,N=0 F S K=$O(GMRACT("O",K)) Q:K'>0 D 115 .I N=0 D 116 ..S Y=$P(GMRACT("O",K),U) D DD^%DT 117 ..S ORAY(I)=" Obs dates/severity: "_Y_" "_$P(GMRACT("O",K),U,2),I=I+1 118 .E D 119 ..S Y=$P(GMRACT("O",K),U) D DD^%DT 120 ..S ORAY(I)=" "_Y_" "_$P(GMRACT("O",K),U,2),I=I+1 121 .S N=N+1 122 S ORAY(I)=" ",I=I+1 123 K N,K,Y 124 Q 125 COM S K=0,N=0,ORAY(I)=" ",I=I+1 126 F S K=$O(GMRACT("C",K)) Q:K'>0 D 127 .I N=0 S ORAY(I)="Comments:",I=I+1 128 .S Y=$P(GMRACT("C",K),U) D DD^%DT 129 .S ORAY(I)=" "_Y_" by "_$P(GMRACT("C",K),U,2),I=I+1 130 .I $D(GMRACT("C",K,1,0)) S L=0 F S L=$O(GMRACT("C",K,L)) Q:L'>0 D 131 ..S ORAY(I)=GMRACT("C",K,L,0),I=I+1 132 .S N=N+1 133 S ORAY(I)=" ",I=I+1 134 K N,K,L,Y 135 Q 1 ORQQAL ; slc/CLA,JFR - Functions which return patient allergy data ;6/8/06 14:11 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,85,162,190,216,232**;Dec 17, 1997;Build 19 3 LIST(ORAY,ORPT) ; RETURN PATIENT'S ALLERGY/ADVERSE REACTION INFO: 4 ; null:no allergy assessment, 0:no known allergies, 1:pt has allergies 5 ; if 1 also get: allergen/reactant^reaction/symptom^severity^allergy ien 6 N I,J,K 7 S I=1,J=0,K=0 8 D EN1^GMRAOR1(ORPT,"GMRARXN") 9 I $G(GMRARXN)="" S ORAY(I)="^No Allergy Assessment" 10 I $G(GMRARXN)=0 S ORAY(I)="^No Known Allergies" 11 I $G(GMRARXN)=1 F S J=$O(GMRARXN(J)) Q:J="" S ORAY(I)=$P(GMRARXN(J),"^",3)_"^"_$P(GMRARXN(J),"^")_"^"_$P(GMRARXN(J),"^",2) D SIGNS S I=I+1 12 S:'$D(ORAY(1)) ORAY(1)="^No allergies found." 13 K GMRARXN 14 Q 15 SIGNS S K=0,N=0 F S K=$O(GMRARXN(J,"S",K)) Q:K'>0 D 16 .I N=0 S ORAY(I)=ORAY(I)_"^"_$P(GMRARXN(J,"S",K),";") 17 .E S ORAY(I)=ORAY(I)_";"_$P(GMRARXN(J,"S",K),";") 18 .S N=N+1 19 Q 20 LRPT(ORAY,ORPT) ; RETURN PT'S ALLERGY/ADVERSE REACTION INFO IN REPORT FORMAT: 21 ; null:no allergy assessment, 0:no known allergies, 1:pt has allergies 22 ; if 1 also get: allergen/reactant^reaction/symptom^severity^allergy ien 23 N I,J,K,SEVER,CR,GMRAIDT ;216 24 S CR=$CHAR(13) 25 S I=1,J=0,K=0,SEVER="",GMRAIDT=1 ;216 26 D EN1^GMRAOR1(ORPT,"GMRARXN") 27 I $G(GMRARXN)="" S ORAY(I)="No Allergy Assessment" 28 I $G(GMRARXN)=0 S ORAY(I)="No Known Allergies" 29 I $G(GMRARXN)=1 F S J=$O(GMRARXN(J)) Q:J="" D 30 .S SEVER=$P(GMRARXN(J),U,2) 31 .S ORAY(I)=$P(GMRARXN(J),U)_" "_$S($L($G(SEVER)):"[Severity: "_SEVER_"]",1:""),I=I+1 32 .S K=0,N=0 F S K=$O(GMRARXN(J,"S",K)) Q:K'>0 D 33 ..I N=0 S ORAY(I)=" Signs/symptoms: "_$P(GMRARXN(J,"S",K),";") 34 ..E S ORAY(I)=" "_$P(GMRARXN(J,"S",K),";") 35 ..I $P(GMRARXN(J,"S",K),";",2) S ORAY(I)=ORAY(I)_" ("_$$FMTE^XLFDT($P(GMRARXN(J,"S",K),";",2),2)_")" ;216 36 ..S N=N+1,I=I+1 37 .S ORAY(I)=" ",I=I+1 38 S:'$D(ORAY(1)) ORAY(1)="No allergies found." 39 K GMRARXN 40 Q 41 RXN(ORAY,ORPT,SRC,NDF,PSDRUG) ; RETURN TRUE OR FALSE IF PATIENT IS ALLERGIC TO AGENT 42 ; SRC: ALLERGEN SOURCE (CM=CONTRAST MEDIA, DR=DRUG) 43 ; NDF: IF SRC=DR, NDF=Nat'l Drug File ien ELSE NDF="" 44 ; PSDRUG:IF SRC=DR, PSDRUG=(local) Drug file ien ELSE PSDRUG="" 45 S ORAY=$$ORCHK^GMRAOR(ORPT,SRC,NDF) 46 I SRC="DR",ORAY=1 D ;drug ingredient allergy found 47 .S I=1,J=0 F S J=$O(GMRAING(J)) Q:J="" D 48 ..I I=1 S ORAY=ORAY_U_GMRAING(J) 49 ..E S ORAY=ORAY_";"_GMRAING(J) 50 ..S I=I+1 51 I SRC="DR",ORAY=2 D ;drug class allergy found 52 .S CL="",I=1,J=0 F S J=$O(GMRADRCL(J)) Q:J="" D 53 ..; per test sites 3/17/04 - no oc for pt allergy to entire HERBS class: 54 ..Q:$P(GMRADRCL(J),U)="HA000" 55 ..I I=1 S ORAY=ORAY_U_$P(GMRADRCL(J),U,2) 56 ..E S CL=$P(GMRADRCL(J),U,2) I ORAY'[CL S ORAY=ORAY_";"_CL 57 ..S I=I+1 58 I SRC="DR",(+$G(ORAY)<1) D MEDCLASS(.ORAY,ORPT,PSDRUG) 59 K I,J,GMRADRCL,GMRAING,CL 60 Q 61 MEDCLASS(ORAY,DFN,PSDRUG) ;check for allergens with medications in same VA drug class 62 N ORVACLS,CL,X,I,RET,TYP 63 S TYP="DR" 64 Q:+$G(PSDRUG)<1 65 S ORVACLS=$P(^PSDRUG(PSDRUG,0),U,2) 66 Q:$L(ORVACLS)<4 67 Q:$G(ORVACLS)="HA000" ;don't process herbal drug class for order checks 68 S CL=$S($E(ORVACLS,1,4)="CN10":5,1:4) ;look at 5 chars if ANALGESICS 69 D GETDATA^GMRAOR(DFN) 70 Q:'$D(^TMP("GMRAOC",$J,"APC")) 71 S I="" F S I=$O(^TMP("GMRAOC",$J,"APC",I)) Q:'$L(I) D 72 .I $E(I,1,CL)=$E(ORVACLS,1,CL) S X=I 73 I $L($G(X)) D 74 .N IEN,NAME 75 .D IEN^PSN50P65(,X,"ORQQAL") 76 .S IEN=$O(^TMP($J,"ORQQAL","B",X,0)) 77 .I 'IEN S ORAY="2"_U_X Q 78 .S NAME=$G(^TMP($J,"ORQQAL",IEN,1)) 79 .I '$L(NAME) S ORAY="2"_U_X Q 80 .S ORAY="2"_U_NAME_": ("_$G(^TMP("GMRAOC",$J,"APC",X))_")" 81 K ^TMP("GMRAOC",$J) 82 Q 83 DETAIL(ORAY,DFN,ALLR,ID) ; RETURN DETAILED ALLERGY INFO FOR SPECIFIED ALLERGIC REACTION: 84 D EN1^GMRAOR2(ALLR,"GMRACT") 85 N CR,OX,OH S CR=$CHAR(13),I=1 86 S ORAY(I)=" Causative agent: "_$P(GMRACT,U),I=I+1 87 S ORAY(I)=" Nature of Reaction: "_$S($P(GMRACT,U,6)="ALLERGY":"Allergy",$P(GMRACT,U,6)="PHARMACOLOGIC":"Adverse Reaction",$P(GMRACT,U,6)="UNKNOWN":"Unknown",1:""),I=I+1 ;216 88 S ORAY(I)=" ",I=I+1 89 I $D(GMRACT("S",1)) D SYMP 90 I $D(GMRACT("V",1)) D CLAS 91 S ORAY(I)=" Originator: "_$P(GMRACT,U,2)_$S($L($P(GMRACT,U,3)):" ("_$P(GMRACT,U,3)_")",1:""),I=I+1 ;216 92 S ORAY(I)=" Originated: "_$P(GMRACT,U,10),I=I+1 ;216 93 I $D(GMRACT("O",1)) D OBS 94 S ORAY(I)=" Verified: "_$S($P(GMRACT,U,4)="VERIFIED":$P(GMRACT,U,8),1:"No"),I=I+1 ;216 95 S ORAY(I)="Observed/Historical: "_$S($P(GMRACT,U,5)="OBSERVED":"Observed",$P(GMRACT,U,5)="HISTORICAL":"Historical",1:""),I=I+1 96 I $D(GMRACT("C",1)) D COM 97 K GMRACT 98 Q 99 SYMP S K=0,N=0 F S K=$O(GMRACT("S",K)) Q:K'>0 D 100 .I N=0 S ORAY(I)=" Signs/symptoms: "_GMRACT("S",K),I=I+1 101 .E S ORAY(I)=" "_GMRACT("S",K),I=I+1 102 .S N=N+1 103 S ORAY(I)=" ",I=I+1 104 K N,K 105 Q 106 CLAS S K=0,N=0 F S K=$O(GMRACT("V",K)) Q:K'>0 D 107 .I N=0 S ORAY(I)=" Drug Classes: "_$P(GMRACT("V",K),U,2),I=I+1 108 .E S ORAY(I)=" "_$P(GMRACT("V",K),U,2),I=I+1 109 .S N=N+1 110 S ORAY(I)=" ",I=I+1 111 K N,K 112 Q 113 OBS S K=0,N=0 F S K=$O(GMRACT("O",K)) Q:K'>0 D 114 .I N=0 D 115 ..S Y=$P(GMRACT("O",K),U) D DD^%DT 116 ..S ORAY(I)=" Obs dates/severity: "_Y_" "_$P(GMRACT("O",K),U,2),I=I+1 117 .E D 118 ..S Y=$P(GMRACT("O",K),U) D DD^%DT 119 ..S ORAY(I)=" "_Y_" "_$P(GMRACT("O",K),U,2),I=I+1 120 .S N=N+1 121 S ORAY(I)=" ",I=I+1 122 K N,K,Y 123 Q 124 COM S K=0,N=0,ORAY(I)=" ",I=I+1 125 F S K=$O(GMRACT("C",K)) Q:K'>0 D 126 .I N=0 S ORAY(I)="Comments:",I=I+1 127 .S Y=$P(GMRACT("C",K),U) D DD^%DT 128 .S ORAY(I)=" "_Y_" by "_$P(GMRACT("C",K),U,2),I=I+1 129 .I $D(GMRACT("C",K,1,0)) S L=0 F S L=$O(GMRACT("C",K,L)) Q:L'>0 D 130 ..S ORAY(I)=GMRACT("C",K,L,0),I=I+1 131 .S N=N+1 132 S ORAY(I)=" ",I=I+1 133 K N,K,L,Y 134 Q
Note:
See TracChangeset
for help on using the changeset viewer.
