source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQCON98.m@ 1446

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

initial load of FOIAVistA 6/30/08 version

File size: 2.9 KB
Line 
1VAQCON98 ;ALB/JRP - MESSAGE CONSTRUCTION;14-APR-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3HEAD10 ;COTINUATION FOR BUILDING HEADER BLOCK OF VERSION 1.0
4 ; DECLARATIONS TAKEN CARE OF IN $$HEAD10^VAQCON99
5 ;GET RETURN ADDRESS
6 S DOMAIN=""
7 S X=0
8 S TMP=+$O(^VAT(394.81,0))
9 S:(TMP) X=+$P($G(^VAT(394.81,TMP,0)),"^",2)
10 S:(X) DOMAIN=$P($G(^DIC(4.2,X,0)),"^",1)
11 Q:(DOMAIN="") "-1^Could not determine current domain"
12 ;GET COMMENT (IF NEEDED)
13 I ((TYPE="RES")!(TYPE="UNS")) D
14 .S TMP=0
15 .F S TMP=+$O(^VAT(394.61,TRANPTR,"CMNT",TMP)) Q:('TMP) D Q:(COMMENT'="")
16 ..S COMMENT=$G(^VAT(394.61,TRANPTR,"CMNT",TMP,0))
17 ..S:(COMMENT?1." ") COMMENT=""
18 ..S COMMENT=$TR(COMMENT,";",",")
19 I (TYPE="ACK") D
20 .S X=$P($G(^VAT(394.61,TRANPTR,"RQST2")),"^",2)
21 .S TMP=$P($$RES^VAQUTL99(X,SSN),"^",2)
22 .S COMMENT="Request requires user intervention"
23 .S:(TMP'="") COMMENT=COMMENT_" ("_TMP_")"
24 ;BUILD VERSION 1.0 ACK
25 I (TYPE="ACK") D Q
26 .S TMP="ACK^"_PARENT_"^"_DATETIME_"^"_"^"_STAT10_"^"_COMMENT
27 .S:('MESSNUM) @ARRAY@(LINE)=TMP
28 .S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
29 .S LINE=LINE+1
30 ;BUILD VERSION 1.0 HEADER
31 ;LINE 1
32 S TMP=PARENT_"^"_NAME_"^"_SSN_"^"_CLAIM_"^"_DOB_"^"_PID_"^"_RQSTDUZ
33 S TMP=TMP_"^"_RQSTNAME_"^"_DATETIME_"^"_RQSTSITE_"^"_CODE10_"^"_STAT10
34 S TMP=TMP_"^"_RQSTNUM_"^"_ATHRDUZ_"^"_ATHRNAME_"^"_ATHRSITE
35 S:('MESSNUM) @ARRAY@(LINE)=TMP
36 S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
37 S LINE=LINE+1
38 ;LINE 2
39 S TMP=DOMAIN_"^"_COMMENT
40 S:('MESSNUM) @ARRAY@(LINE)=TMP
41 S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
42 S LINE=LINE+1
43 Q
44 ;
45MIN10 ;BUILD VERSION 1.0 MINIMUM DATA BLOCK
46 ; DECLARATIONS TAKEN CARE OF IN $$DATA^VAQCON69
47 S SEGABB="PDX*MIN"
48 ;MAS DATA NOT PRESENT - PLACE NULLS INTO MESSAGE
49 I ('$D(@ROOT@(SEGABB))) D NULLS Q
50 S FILE=""
51 F S FILE=$O(@ROOT@(SEGABB,"VALUE",FILE)) Q:(FILE="") D
52 .S INFO="MIN"_"^"_FILE_"^"
53 .S FIELD=""
54 .F S FIELD=$O(@ROOT@(SEGABB,"VALUE",FILE,FIELD)) Q:(FIELD="") D
55 ..S SEQ=0
56 ..S VALUE=$G(@ROOT@(SEGABB,"VALUE",FILE,FIELD,SEQ))
57 ..;PUT DATES IN FILEMAN FORMAT
58 ..I (VALUE'="") S:($P($G(^DD(FILE,FIELD,0)),"^",2)["D") VALUE=$$DATE^VAQUTL99(VALUE)
59 ..I (($L(INFO)+$L(VALUE)+$L(FIELD)+2)>239) D
60 ...S:('MESSNUM) @ARRAY@(LINE)=INFO
61 ...S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
62 ...S LINE=LINE+1
63 ...S INFO="MIN"_"^"_FILE_"^"
64 ..S X=$P(INFO,"^",3)
65 ..S $P(INFO,"^",3)=$S((X=""):FIELD,1:(X_";"_FIELD))
66 ..S INFO=INFO_"^"_VALUE
67 .I ($P(INFO,"^",3)'="") D
68 ..S:('MESSNUM) @ARRAY@(LINE)=INFO
69 ..S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
70 ..S LINE=LINE+1
71NULLS ;CHECK FOR FIELDS THAT DIDN'T HAVE VALUES
72 F SEQ=1:1 D Q:('SEQ)
73 .S TMP=$P($T(MIN+SEQ^VAQDBII1),";;",2)
74 .I (TMP="") S SEQ=0 Q
75 .S FILE=$P(TMP,";",1)
76 .S FIELD=$P(TMP,";",2)
77 .F VALUE=1:1:$L(FIELD,",") D
78 ..S TMP=$P(FIELD,",",VALUE)
79 ..Q:($D(@ROOT@(SEGABB,"VALUE",FILE,TMP)))
80 ..S INFO="MIN"_"^"_FILE_"^"_TMP
81 ..S:('MESSNUM) @ARRAY@(LINE)=INFO
82 ..S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,XMZ,LINE)
83 ..S LINE=LINE+1
84 Q
Note: See TracBrowser for help on using the repository browser.