1 | VAQDIS42 ;ALB/JRP/JFP - PRINT ACTION PROFILE (CONT);30APR92
|
---|
2 | ;;1.5;PATIENT DATA EXCHANGE;**13**;NOV 17, 1993
|
---|
3 | DEMOG ;PRINT PHARMACY DEMOGRAPHICS
|
---|
4 | ;CHECK PARAMETERS
|
---|
5 | N LOOP,X,TMP,TMP1,TMP2,ADDRESS,FLAG
|
---|
6 | ;
|
---|
7 | R1 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
|
---|
17 | R2 ;
|
---|
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
|
---|
22 | R3 ;
|
---|
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
|
---|
27 | R4 ;
|
---|
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
|
---|
32 | R5 ;
|
---|
33 | I $D(ADDRESS(4)) S X=$$SETSTR^VALM1(ADDRESS(4),"",1,40) D TMP^VAQDIS20
|
---|
34 | K ADDRESS
|
---|
35 | D BLANK^VAQDIS20
|
---|
36 | ;
|
---|
37 | R6 ; -- 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 | ;
|
---|
50 | R7 ; -- 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 | ;
|
---|
65 | R8 ; -- 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 | ;
|
---|
79 | SETNAR ; -- 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 | ;
|
---|
89 | END ; -- End of Code
|
---|
90 | QUIT
|
---|
91 | ;
|
---|