| 1 | PSJALG ;BIR/UK-DETAILED ALLERGY LIST ;15 May 98 / 9:27 AM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**3,85**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to ^GMRPNCW is supported by DBIA 10123.
|
|---|
| 5 | ; Reference to CWAD^ORQPT2 is supported by DBIA 2831.
|
|---|
| 6 | ;
|
|---|
| 7 | EN ; -- main entry point for PSJ LM ALLERGY DETAIL
|
|---|
| 8 | D EN^VALM("PSJ LM ALLERGY DETAIL")
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | ;
|
|---|
| 12 | INIT ; -- init variables and list array
|
|---|
| 13 | F LINE=1:1:30 D SET^VALM10(LINE,LINE_" Line number "_LINE)
|
|---|
| 14 | S VALMCNT=30
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | HELP ; -- help code
|
|---|
| 18 | S X="?" D DISP^XQORM1 W !!
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | EXIT ; -- exit code
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | EXPND ; -- expand code
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | DETAIL ;
|
|---|
| 28 | N CAUSATIV,TYPE,BLANKS S BLANKS=" " F I=1:1:16 S BLANKS=BLANKS_" "
|
|---|
| 29 | D ^GMRADPT
|
|---|
| 30 | I $G(GMRAL)=0 S ^TMP("PSJALLRG",$J,1,0)="PATIENT HAS NO KNOWN ALLERGIES" Q
|
|---|
| 31 | I $G(GMRAL)="" S ^TMP("PSJALLRG",$J,1,0)="PATIENT HAS NOT BEEN ASKED ABOUT ALLERGIES" Q
|
|---|
| 32 | N LINE,NUM,I,J,DATA S (I,J)=0
|
|---|
| 33 | F S I=$O(GMRAL(I)) Q:I="" S DATA=$G(GMRAL(I)) Q:DATA="" S TYPE=$P(DATA,"^",3),J=J+1,PSJAL(TYPE,J)=$P(DATA,"^",2)_"^"_I,PSJAL("TOTAL")=J
|
|---|
| 34 | S J=0 F TYPE="D","DF","DFO","DO","F","FO","O" D
|
|---|
| 35 | .S I=0,CAPTION=$S(TYPE="D":"DRUG:",TYPE="F":"FOOD:",TYPE="DF":"DRUG/FOOD:",TYPE="DFO":"DRUG/FOOD/OTHER:",TYPE="DO":"DRUG/OTHER",TYPE="FO":"FOOD/OTHER:",1:"OTHER:"),CAPTION=CAPTION_$E(BLANKS,$L(CAPTION),17) D
|
|---|
| 36 | ..F S I=$O(PSJAL(TYPE,I)) Q:I="" D
|
|---|
| 37 | ...S J=J+1,CAUSATIV=$G(PSJAL(TYPE,I)) Q:CAUSATIV=""
|
|---|
| 38 | ...S ^TMP("PSJALLRG",$J,J,0)=" "_CAPTION_" "_J_$S($L(J)=2:" ",1:" ")_$P(CAUSATIV,"^")
|
|---|
| 39 | ...S CAPTION=" "
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | VIEW ;
|
|---|
| 43 | Q
|
|---|
| 44 | N NUMBER,STRING,TOTAL,BLANKS,IEN S BLANKS=" " F I=1:1:49 S BLANKS=BLANKS_" "
|
|---|
| 45 | S TOTAL=$G(PSJAL("TOTAL")) Q:'TOTAL
|
|---|
| 46 | S DIR(0)="N^1:"_TOTAL_":0",DIR("A")="Select Allergy/ADR" D ^DIR Q:Y="^" K DIR
|
|---|
| 47 | F TYPE="D","DF","DFO","DO","F","FO","O" S CAUSATIV=$G(PSJAL(TYPE,Y)) Q:CAUSATIV'=""
|
|---|
| 48 | S NUMBER=$P(CAUSATIV,"^",2),J=1 D EN1^GMRAOR2(IEN,"PSJARRAY")
|
|---|
| 49 | S STRING=" CAUSATIVE AGENT: "_$P(CAUSATIV,"^"),STRING=STRING_$E(BLANKS,$L(STRING),50)_"VA DRUG CLASS: "_$P(PSJARRAY("V",1),"^"),^TMP("PSJALLDT",$J,J,0)=STRING
|
|---|
| 50 | K PSJARRAY
|
|---|
| 51 | Q
|
|---|
| 52 | CWAD(DFN) ;
|
|---|
| 53 | I $$CWAD^ORQPT2(DFN)="" W !!,"No CWAD information for this patient." D PAUSE^VALM1 Q
|
|---|
| 54 | W !!
|
|---|
| 55 | NEW Y,GMRPDFN,GMRPOPT,GMRPEN,GMTSPHDR
|
|---|
| 56 | S (Y,GMRPDFN)=DFN,GMRPOPT=1,GMRPEN=1
|
|---|
| 57 | D ENPAT^GMRPNCW
|
|---|
| 58 | Q
|
|---|
