source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJALG.m@ 1211

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

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1PSJALG ;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 ;
7EN ; -- main entry point for PSJ LM ALLERGY DETAIL
8 D EN^VALM("PSJ LM ALLERGY DETAIL")
9 Q
10 ;
11 ;
12INIT ; -- 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 ;
17HELP ; -- help code
18 S X="?" D DISP^XQORM1 W !!
19 Q
20 ;
21EXIT ; -- exit code
22 Q
23 ;
24EXPND ; -- expand code
25 Q
26 ;
27DETAIL ;
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 ;
42VIEW ;
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
52CWAD(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
Note: See TracBrowser for help on using the repository browser.