source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQCON95.m@ 681

Last change on this file since 681 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1VAQCON95 ;ALB/JRP - MESSAGE CONSTRUCTION;20-APR-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3PHA10 ;BUILD PHARMACY DATA BLOCK FOR 1.0 MESSAGE
4 ; DECLARATIONS DONE IN $$DATA10^VAQCON97
5 S SEGABB="PDX*MPL"
6 ;LONG FORMAT NOT PRESENT - SWITCH TO SHORT FORMAT (SAME INFO)
7 S:('$D(@ROOT@(SEGABB))) SEGABB="PDX*MPS"
8 ;PHARMACY DATA NOT PRESENT - PLACE NULLS INTO MESSAGE
9 I ('$D(@ROOT@(SEGABB))) D NULLS Q
10 ;PLACE NARRATIVE INTO MESSAGE
11 S FILE=55
12 S FIELD=1
13 S VALUE=$G(@ROOT@(SEGABB,"VALUE",FILE,FIELD,0))
14 S INFO="PHA"_"^"_FILE_"^"_FIELD_"^"_VALUE
15 S:('MESSNUM) @ARRAY@(LINE)=INFO
16 S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
17 S LINE=LINE+1
18 ;PLACE ALERGIES & REACTIONS INTO MESSAGE (STORE IN 2.55;.01)
19 S FILE=120.8
20 S FIELD=.02
21 S INFO="PHA"_"^"_(2.55)_"^"_(.01)
22 S SEQ=""
23 F S SEQ=$O(@ROOT@(SEGABB,"VALUE",FILE,FIELD,SEQ)) Q:(SEQ="") D
24 .S VALUE=$G(@ROOT@(SEGABB,"VALUE",FILE,FIELD,SEQ))
25 .I (($L(INFO)+$L(VALUE)+$L(FIELD)+1)>239) D
26 ..S:('MESSNUM) @ARRAY@(LINE)=INFO
27 ..S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
28 ..S LINE=LINE+1
29 ..S INFO="PHA"_"^"_(2.55)_"^"_(.01)
30 .S INFO=INFO_"^"_VALUE
31 S:('MESSNUM) @ARRAY@(LINE)=INFO
32 S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
33 S LINE=LINE+1
34 ;STORE NULL VALUES FOR 2.57;.01
35 S INFO="PHA"_"^"_(2.57)_"^"_(.01)
36 S:('MESSNUM) @ARRAY@(LINE)=INFO
37 S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
38 S LINE=LINE+1
39 ;PLACE DISABILITIES INTO MESSAGE
40 ;ASSUMES THAT ALL SEQUENCES IN THE SUBFILE ARE THE SAME
41 S FILE=2.04
42 S SEQFIELD=.01
43 S SEQ=""
44 S INFO="PHA"_"^"_FILE_"^"_".01;2;3"
45 F S SEQ=$O(@ROOT@(SEGABB,"VALUE",FILE,SEQFIELD,SEQ)) Q:(SEQ="") D
46 .S INFO="PHA"_"^"_FILE_"^"_".01;2;3"
47 .F FIELD=.01,2,3 D
48 ..S VALUE=$G(@ROOT@(SEGABB,"VALUE",FILE,FIELD,SEQ))
49 ..S INFO=INFO_"^"_VALUE
50 .S:('MESSNUM) @ARRAY@(LINE)=INFO
51 .S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
52 .S LINE=LINE+1
53 ;STORE NULL DISABILITIES (IF NEEDED)
54 I ($L(INFO,"^")<4) D
55 .S:('MESSNUM) @ARRAY@(LINE)=INFO
56 .S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
57 .S LINE=LINE+1
58 ;NO PRESCRIPTION INFORMATION - STORE NULLS
59 I ('$D(@ROOT@(SEGABB,"VALUE",52,.01))) D NULLRX Q
60 ;STORE PRESCRIPTION INFORMATION
61 ;ASSUMES ALL PRESCRIPTION INFO HAVE SAME SEQUENCE
62 S FILE=52
63 S SEQFIELD=.01
64 S SEQ=""
65 F S SEQ=$O(@ROOT@(SEGABB,"VALUE",FILE,SEQFIELD,SEQ)) Q:(SEQ="") D
66 .;GET RX#
67 .S FIELD=.01
68 .S VALUE=$G(@ROOT@(SEGABB,"VALUE",FILE,FIELD,SEQ))
69 .Q:(VALUE="")
70 .S INFO="PHA"_"^"_FILE_"^"_FIELD_"^"_VALUE
71 .;GET REST OF PRESCRIPTION INFO
72 .F S FIELD=$O(@ROOT@(SEGABB,"VALUE",FILE,FIELD)) Q:(FIELD="") D
73 ..S VALUE=$G(@ROOT@(SEGABB,"VALUE",FILE,FIELD,SEQ))
74 ..;CONVERT DATES TO FILEMAN FORMAT
75 ..I (VALUE'="") S:($P($G(^DD(FILE,FIELD,0)),"^",2)["D") VALUE=$$DATE^VAQUTL99(VALUE)
76 ..I (($L(INFO)+$L(VALUE)+$L(FIELD)+2)>239) D
77 ...S:('MESSNUM) @ARRAY@(LINE)=INFO
78 ...S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
79 ...S LINE=LINE+1
80 ...S X=INFO
81 ...S INFO="PHA"_"^"_(52)_"^"_(.01)_"^"_($P(X,"^",4))
82 ..S X=$P(INFO,"^",3)
83 ..S $P(INFO,"^",3)=$S((X=""):FIELD,1:(X_";"_FIELD))
84 ..S INFO=INFO_"^"_VALUE
85 .I ($P(INFO,"^",3)[";") D
86 ..S:('MESSNUM) @ARRAY@(LINE)=INFO
87 ..S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
88 ..S LINE=LINE+1
89 ;STORE REFILL INFORMATION
90 S FILE=52.1
91 S FIELD=.01
92 S SEQ=""
93 F S SEQ=$O(@ROOT@(SEGABB,"VALUE",FILE,FIELD,SEQ)) Q:(SEQ="") D
94 .;GET RX
95 .S TMP=$G(@ROOT@(SEGABB,"ID",FILE,FIELD,SEQ))
96 .Q:(TMP="")
97 .;SPECIAL CASE DATA LINE
98 .S INFO="PHA"_"^"_FILE_"^"_FIELD_"~"_TMP
99 .S VALUE=$G(@ROOT@(SEGABB,"VALUE",FILE,FIELD,SEQ))
100 .;CONVERT DATE TO FILEMAN FORMAT
101 .S:(VALUE'="") VALUE=$$DATE^VAQUTL99(VALUE)
102 .S INFO=INFO_"^"_VALUE
103 .S:('MESSNUM) @ARRAY@(LINE)=INFO
104 .S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
105 .S LINE=LINE+1
106 Q
107NULLS ;NO PRESCRIPTION INFO (STORE NULLS)
108 ;PATIENT INFO
109 F SEQ=1:1 D Q:('SEQ)
110 .S TMP=$P($T(RXPAT+SEQ^VAQDBII1),";;",2)
111 .I (TMP="") S SEQ=0 Q
112 .S TMP=$TR(TMP,";","^")
113 .S TMP=$TR(TMP,",",";")
114 .S INFO="PHA"_"^"_TMP
115 .S:('MESSNUM) @ARRAY@(LINE)=INFO
116 .S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
117 .S LINE=LINE+1
118NULLRX ;PRESCRIPTION INFO
119 F SEQ=1:1 D Q:('SEQ)
120 .S TMP=$P($T(PROFILE+SEQ^VAQDBII1),";;",2)
121 .I (TMP="") S SEQ=0 Q
122 .S TMP=$TR(TMP,";","^")
123 .S TMP=$TR(TMP,",",";")
124 .;.01 MUST BE FIRST FIELD FOR FILE 52
125 .I ($P(TMP,"^",1)=52) D
126 ..S X=$P(TMP,"^",2)
127 ..S:($P(X,";",1)'=".01") X=".01;"_X
128 ..S $P(TMP,"^",2)=X
129 .S INFO="PHA"_"^"_TMP
130 .S:('MESSNUM) @ARRAY@(LINE)=INFO
131 .S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
132 .S LINE=LINE+1
133 Q
Note: See TracBrowser for help on using the repository browser.