source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQDIS42.m@ 770

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

initial load of WorldVistAEHR

File size: 3.2 KB
RevLine 
[613]1VAQDIS42 ;ALB/JRP/JFP - PRINT ACTION PROFILE (CONT);30APR92
2 ;;1.5;PATIENT DATA EXCHANGE;**13**;NOV 17, 1993
3DEMOG ;PRINT PHARMACY DEMOGRAPHICS
4 ;CHECK PARAMETERS
5 N LOOP,X,TMP,TMP1,TMP2,ADDRESS,FLAG
6 ;
7R1 S X=$$SETSTR^VALM1($G(@XTRCT@("VALUE",2,.01,0)),"",1,40)
8 S X=$$SETSTR^VALM1("SSN: "_$G(@XTRCT@("VALUE",2,.09,0)),X,42,37)
9 D TMP^VAQDIS20
10 ; -- SET UP ADDRESS ARRAY
11 S X=1
12 F LOOP=.111,.112,.113 D
13 .S VAQTMP=$G(@XTRCT@("VALUE",2,LOOP,0))
14 .I VAQTMP'="" S ADDRESS(X)=VAQTMP,X=X+1
15 S ADDRESS(X)=$G(@XTRCT@("VALUE",2,.114,0))_", "_$G(@XTRCT@("VALUE",2,.115,0))_" "_$G(@XTRCT@("VALUE",2,.1112,0))
16 K LOOP,VAQTMP,X
17R2 ;
18 S VAQINF=$S($D(ADDRESS(1)):ADDRESS(1),1:"")
19 S X=$$SETSTR^VALM1(VAQINF,"",1,40)
20 S X=$$SETSTR^VALM1("DOB: "_$G(@XTRCT@("VALUE",2,.03,0)),X,42,37)
21 D TMP^VAQDIS20 K VAQINF
22R3 ;
23 S VAQINF=$S($D(ADDRESS(2)):ADDRESS(2),1:"")
24 S X=$$SETSTR^VALM1(VAQINF,"",1,39)
25 S X=$$SETSTR^VALM1("Phone: "_$G(@XTRCT@("VALUE",2,.131,0)),X,40,39)
26 D TMP^VAQDIS20 K VAQINF
27R4 ;
28 S VAQINF=$S($D(ADDRESS(3)):ADDRESS(3),1:"")
29 S X=$$SETSTR^VALM1(VAQINF,"",1,40)
30 S X=$$SETSTR^VALM1("Elig: "_$G(@XTRCT@("VALUE",2,.361,0)),X,41,36)
31 D TMP^VAQDIS20 K VAQINF
32R5 ;
33 I $D(ADDRESS(4)) S X=$$SETSTR^VALM1(ADDRESS(4),"",1,40) D TMP^VAQDIS20
34 K ADDRESS
35 D BLANK^VAQDIS20
36 ;
37R6 ; -- Print Narrative
38 S VAQTMP=$G(@XTRCT@("VALUE",55,1,0))
39 I VAQTMP="" S X=$$SETSTR^VALM1("Pharmacy Narrative: None","",1,79) D TMP^VAQDIS20
40 I VAQTMP'="" D
41 .D SETNAR
42 .S K=""
43 .F J=0:0 S K=$O(LN($J,K)) Q:K="" D
44 ..S:K=1 X=$$SETSTR^VALM1("Pharmacy Narrative:"_$G(LN($J,K)),"",1,79)
45 ..S:K'=1 X=$$SETSTR^VALM1(" "_$G(LN($J,K)),"",1,79)
46 ..D TMP^VAQDIS20
47 D BLANK^VAQDIS20
48 K VAQTMP,VAQLN,VAQWORD,LN,K,J
49 ;
50R7 ; -- Print rated disabilities
51 S SEQ=""
52 F J=1:1 S SEQ=$O(@XTRCT@("VALUE",2.04,.01,SEQ)) Q:SEQ="" D
53 .S VAQTMP1=$G(@XTRCT@("VALUE",2.04,.01,SEQ))
54 .S VAQTMP2=$G(@XTRCT@("VALUE",2.04,2,SEQ))
55 .S VAQTMP3=$G(@XTRCT@("VALUE",2.04,3,SEQ))
56 .S VAQTMP4=$S(VAQTMP3="YES":"SC",1:"NSC")
57 .S VAQINF=VAQTMP1_" ("_VAQTMP2_"%-"_VAQTMP4_")"
58 .S:J=1 X=$$SETSTR^VALM1("Rated Disabilities: "_VAQINF,"",1,79)
59 .S:J'=1 X=$$SETSTR^VALM1(" "_VAQINF,"",1,79)
60 .D TMP^VAQDIS20
61 I J=1 S X=$$SETSTR^VALM1("Rated Disability: None","",1,79) D TMP^VAQDIS20
62 D BLANK^VAQDIS20
63 K VAQTMP1,VAQTMP2,VAQTMP3,VAQTMP4,VAQINF,SEQ,J
64 ;
65R8 ; -- PRINT REACTIONS
66 S (SEQ,VAQLN)=""
67 F J=1:1 S SEQ=$O(@XTRCT@("VALUE",120.8,.02,SEQ)) Q:SEQ="" D
68 .S VAQTMP=$G(@XTRCT@("VALUE",120.8,.02,SEQ))
69 .I ($L(VAQLN_", "_VAQTMP)>68)&(J=1) S X=$$SETSTR^VALM1("Reactions: "_VAQLN,"",1,79) D TMP^VAQDIS20 S VAQLN=""
70 .I ($L(VAQLN_", "_VAQTMP)>68)&(J'=1) S X=$$SETSTR^VALM1(" "_VAQLN,"",1,79) D TMP^VAQDIS20 S VAQLN=""
71 .I J=1 S VAQLN=VAQLN_VAQTMP
72 .I J'=1 S VAQLN=VAQLN_", "_VAQTMP
73 I VAQLN'="" S X=$$SETSTR^VALM1("Reactions: "_VAQLN,"",1,79) D TMP^VAQDIS20
74 I VAQLN="" S X=$$SETSTR^VALM1("Reactions: None","",1,79) D TMP^VAQDIS20
75 K VAQTMP,VAQLN,SEQ,J
76 D BLANK^VAQDIS20
77 QUIT
78 ;
79SETNAR ; -- Sets display line for narrative
80 S VAQLN="",K=1
81 F J=1:1 D Q:VAQWORD=""
82 .S VAQWORD=$P(VAQTMP," ",J)
83 .Q:VAQWORD=""
84 .I ($L(VAQLN_" "_VAQWORD)>59) S LN($J,K)=VAQLN,VAQLN="",K=K+1
85 .S VAQLN=VAQLN_" "_VAQWORD
86 I $D(VAQLN) S LN($J,K)=VAQLN
87 QUIT
88 ;
89END ; -- End of Code
90 QUIT
91 ;
Note: See TracBrowser for help on using the repository browser.