source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQCON96.m@ 761

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

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1VAQCON96 ;ALB/JRP - MESSAGE CONSTRUCTION;20-APR-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3MAS10 ;BUILD MAS DATA BLOCK FOR 1.0 MESSAGE
4 ; DECLARATIONS DONE IN $$DATA10^VAQCON97
5 S SEGABB="PDX*MAS"
6 ;MAS DATA NOT PRESENT - PLACE NULLS INTO MESSAGE
7 I ('$D(@ROOT@(SEGABB))) D NULLS Q
8 ;PLACE NON-MULTIPLE FIELDS INTO MESSAGE
9 S FILE=2
10 S INFO="MAS"_"^"_FILE_"^"
11 S FIELD=""
12 F S FIELD=$O(@ROOT@(SEGABB,"VALUE",FILE,FIELD)) Q:(FIELD="") D
13 .S SEQ=0
14 .S VALUE=$G(@ROOT@(SEGABB,"VALUE",FILE,FIELD,SEQ))
15 .I (VALUE'="") S:($P($G(^DD(FILE,FIELD,0)),"^",2)["D") VALUE=$$DATE^VAQUTL99(VALUE)
16 .I (($L(INFO)+$L(VALUE)+$L(FIELD)+2)>239) D
17 ..S:('MESSNUM) @ARRAY@(LINE)=INFO
18 ..S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
19 ..S LINE=LINE+1
20 ..S INFO="MAS"_"^"_FILE_"^"
21 .S X=$P(INFO,"^",3)
22 .S $P(INFO,"^",3)=$S((X=""):FIELD,1:(X_";"_FIELD))
23 .S INFO=INFO_"^"_VALUE
24 I ($P(INFO,"^",3)'="") D
25 .S:('MESSNUM) @ARRAY@(LINE)=INFO
26 .S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
27 .S LINE=LINE+1
28 ;PLACE MULTIPLE FIELDS FROM PATIENT FILE INTO MESSAGE
29 ;ASSUMES THAT ALL SEQUENCES IN THE SUBFILE ARE THE SAME
30 S FILE=2
31 F S FILE=$O(@ROOT@(SEGABB,"VALUE",FILE)) Q:((FILE'<3)!('FILE)) D
32 .S INFO="MAS"_"^"_FILE_"^"
33 .S SEQFIELD=$O(@ROOT@(SEGABB,"VALUE",FILE,""))
34 .Q:(SEQFIELD="")
35 .S SEQ=""
36 .F S SEQ=$O(@ROOT@(SEGABB,"VALUE",FILE,SEQFIELD,SEQ)) Q:(SEQ="") D
37 ..S FIELD=""
38 ..F S FIELD=$O(@ROOT@(SEGABB,"VALUE",FILE,FIELD)) Q:(FIELD="") D
39 ...S VALUE=$G(@ROOT@(SEGABB,"VALUE",FILE,FIELD,SEQ))
40 ...;PUT DATES IN FILEMAN FORMAT
41 ...I (VALUE'="") S:($P($G(^DD(FILE,FIELD,0)),"^",2)["D") VALUE=$$DATE^VAQUTL99(VALUE)
42 ...I (($L(INFO)+$L(VALUE)+$L(FIELD)+2)>239) D
43 ....S:('MESSNUM) @ARRAY@(LINE)=INFO
44 ....S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
45 ....S LINE=LINE+1
46 ....S INFO="MAS"_"^"_FILE_"^"
47 ...S X=$P(INFO,"^",3)
48 ...S $P(INFO,"^",3)=$S((X=""):FIELD,1:(X_";"_FIELD))
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 ..S INFO="MAS"_"^"_FILE_"^"
54NULLS ;CHECK FOR FIELDS THAT DIDN'T HAVE VALUES
55 ;MAS FIELDS
56 F SEQ=1:1 D Q:('SEQ)
57 .S TMP=$P($T(MAS+SEQ^VAQDBII1),";;",2)
58 .I (TMP="") S SEQ=0 Q
59 .D CHECK
60 ;ELIGIBILITIES
61 F SEQ=1:1 D Q:('SEQ)
62 .S TMP=$P($T(ELIG+SEQ^VAQDBII1),";;",2)
63 .I (TMP="") S SEQ=0 Q
64 .D CHECK
65 ;DENTAL APPOINTMENTS
66 F SEQ=1:1 D Q:('SEQ)
67 .S TMP=$P($T(DENTAL+SEQ^VAQDBII1),";;",2)
68 .I (TMP="") S SEQ=0 Q
69 .D CHECK
70 ;APPOINTMENTS
71 F SEQ=1:1 D Q:('SEQ)
72 .S TMP=$P($T(APPOINT+SEQ^VAQDBII1),";;",2)
73 .I (TMP="") S SEQ=0 Q
74 .D CHECK
75 ;INSURANCE (NEED AT LEAST TWO)
76 F SEQ=1:1 D Q:('SEQ)
77 .S TMP=$P($T(INSURE+SEQ^VAQDBII1),";;",2)
78 .I (TMP="") S SEQ=0 Q
79 .S FILE=$P(TMP,";",1)
80 .S FIELD=$P(TMP,";",2)
81 .F VALUE=1:1:$L(FIELD,",") D
82 ..S TMP=$P(FIELD,",",VALUE)
83 ..I ('$D(@ROOT@(SEGABB,"VALUE",FILE,TMP,0))) D
84 ...S INFO="MAS"_"^"_FILE_"^"_TMP
85 ...S:('MESSNUM) @ARRAY@(LINE)=INFO
86 ...S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,XMZ,LINE)
87 ...S LINE=LINE+1
88 ..Q:($D(@ROOT@(SEGABB,"VALUE",FILE,TMP,1)))
89 ..S INFO="MAS"_"^"_FILE_"^"_TMP
90 ..S:('MESSNUM) @ARRAY@(LINE)=INFO
91 ..S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,XMZ,LINE)
92 ..S LINE=LINE+1
93 Q
94 ;
95CHECK ;CHECK FOR FIELD EXISTANCE
96 S FILE=$P(TMP,";",1)
97 S FIELD=$P(TMP,";",2)
98 F VALUE=1:1:$L(FIELD,",") D
99 .S TMP=$P(FIELD,",",VALUE)
100 .Q:($D(@ROOT@(SEGABB,"VALUE",FILE,TMP)))
101 .S INFO="MAS"_"^"_FILE_"^"_TMP
102 .S:('MESSNUM) @ARRAY@(LINE)=INFO
103 .S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,XMZ,LINE)
104 .S LINE=LINE+1
105 Q
Note: See TracBrowser for help on using the repository browser.