source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQCON0.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1VAQCON0 ;ALB/JRP - MESSAGE CONSTRUCTION;14-APR-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3MESSAGE(TRANPTR,ROOT,MESSNUM,ARRAY,OFFSET) ;BUILD MESSAGE FOR TRANSACTION
4 ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
5 ; ROOT - Location of Extraction Arrays (full global reference)
6 ; MESSNUM - Message number to place message into
7 ; (if 0, message will be placed in ARRAY)
8 ; ARRAY - Array to store message in (full global reference)
9 ; OFFSET - Where to begin placing information (defaults to 0)
10 ;OUTPUT : N - Number of lines in message
11 ; -1^Error_Text - Error
12 ;NOTES : If MESSNUM=0, then the message will be placed into
13 ; ARRAY(LineNumber)=Line_of_info
14 ; If MESSNUM>0 then the message will be placed into
15 ; ^XMB(3.9,MESSNUM,2,LineNumber,0)=Line_of_info
16 ; : The first subscript in ROOT must be the segment abbreviation
17 ; (i.e. ROOT(SegmentAbbreviation)). This is required to
18 ; identify the segment contained in a DATA or DISPLAY block.
19 ;
20 ;CHECK INPUT
21 S TRANPTR=+$G(TRANPTR)
22 Q:(('TRANPTR)!('$D(^VAT(394.61,TRANPTR)))) "-1^Did not pass a valid pointer to VAQ - TRANSACTION file"
23 S ROOT=$G(ROOT)
24 S MESSNUM=+$G(MESSNUM)
25 I (('MESSNUM)&($G(ARRAY)="")) Q "-1^Did not pass message number or reference to array"
26 I (MESSNUM) Q:('$D(^XMB(3.9,MESSNUM))) "-1^Valid message number not passed"
27 S OFFSET=+$G(OFFSET)
28 ;DECLARE VARIABLES
29 N TMP,X,Y,TMPROOT,LINE,TYPE,SEG,STATUS
30 S LINE=OFFSET
31 ;GET MESSAGE STATUS & TYPE
32 S TMP=$$STATYPE^VAQCON1(TRANPTR)
33 Q:($P(TMP,"^",1)="-1") TMP
34 S STATUS=$P(TMP,"^",1)
35 S TYPE=$P(TMP,"^",2)
36 Q:(TYPE="REC") "-1^Transaction is being received, not transmitted"
37 ;START PDX MESSAGE
38 S TMP="$MESSAGE"
39 S:('MESSNUM) @ARRAY@(LINE)=TMP
40 S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
41 S LINE=LINE+1
42 ;HEADER BLOCK
43 S TMP=$$HEADER^VAQCON2(TRANPTR,MESSNUM,ARRAY,LINE)
44 Q:(+TMP=-1) TMP
45 S LINE=LINE+TMP
46 ;DOMAIN BLOCK
47 S TMP=$$DOMAIN^VAQCON4(TRANPTR,MESSNUM,ARRAY,LINE)
48 Q:(+TMP=-1) TMP
49 S LINE=LINE+TMP
50 ;ACK & RE-TRANSMIT COMPLETED
51 G:((TYPE="ACK")!(TYPE="RET")) MESSDONE
52 ;USER BLOCK
53 S TMP=$$USER^VAQCON3(TRANPTR,MESSNUM,ARRAY,LINE)
54 Q:(+TMP=-1) TMP
55 S LINE=LINE+TMP
56 ;PATIENT BLOCK
57 S TMP=$$PATIENT^VAQCON6(TRANPTR,MESSNUM,ARRAY,LINE)
58 Q:(+TMP=-1) TMP
59 S LINE=LINE+TMP
60 ;SEGMENT BLOCK
61 S TMP=$$SEGMENT^VAQCON5(TRANPTR,MESSNUM,ARRAY,LINE)
62 Q:(+TMP=-1) TMP
63 S LINE=LINE+TMP
64 ;REQUEST COMPLETED
65 G:(TYPE="REQ") MESSDONE
66 ;COMMENT BLOCK
67 S TMP=$$COMMENT^VAQCON4(TRANPTR,MESSNUM,ARRAY,LINE)
68 Q:(+TMP=-1) TMP
69 S LINE=LINE+TMP
70 ;PROCESSED REQUEST WITH NO DATA COMPLETED
71 I (TYPE="RES") G:((STATUS="VAQ-AMBIG")!(STATUS="VAQ-NTFND")!(STATUS="VAQ-REJ")) MESSDONE
72 ;DATA BLOCKS
73 S SEG=""
74 I (ROOT'="") F S SEG=$O(@ROOT@(SEG)) Q:(SEG="") I $D(@ROOT@(SEG,"VALUE")) D Q:(+TMP=-1)
75 .;PLACE SEGMENT ABBREVIATION INTO ROOT
76 .S TMP=$P(ROOT,"(",1)
77 .S X=$P(ROOT,"(",2)
78 .S Y=$P(X,")",1)
79 .S:(Y="") TMPROOT=TMP_"("_$C(34)_SEG_$C(34)_")"
80 .S:(Y'="") TMPROOT=TMP_"("_Y_","_$C(34)_SEG_$C(34)_")"
81 .S:(ROOT="") TMPROOT=""
82 .S TMP=$$DATA^VAQCON7(TRANPTR,SEG,TMPROOT,MESSNUM,ARRAY,LINE)
83 .Q:(+TMP=-1)
84 .S LINE=LINE+TMP
85 Q:(+TMP=-1) TMP
86 ;DISPLAY BLOCKS
87 S SEG=""
88 I (ROOT'="") F S SEG=$O(@ROOT@(SEG)) Q:(SEG="") I $D(@ROOT@(SEG,"DISPLAY")) D Q:(+TMP=-1)
89 .;PLACE SEGMENT ABBREVIATION INTO ROOT
90 .S TMP=$P(ROOT,"(",1)
91 .S X=$P(ROOT,"(",2)
92 .S Y=$P(X,")",1)
93 .S:(Y="") TMPROOT=TMP_"("_$C(34)_SEG_$C(34)_")"
94 .S:(Y'="") TMPROOT=TMP_"("_Y_","_$C(34)_SEG_$C(34)_")"
95 .S:(ROOT="") TMPROOT=""
96 .S TMP=$$DISPLAY^VAQCON8(TRANPTR,SEG,TMPROOT,0,"",MESSNUM,ARRAY,LINE)
97 .Q:(+TMP=-1)
98 .S LINE=LINE+TMP
99 Q:(+TMP=-1) TMP
100MESSDONE ;END PDX MESSAGE
101 S TMP="$$MESSAGE"
102 S:('MESSNUM) @ARRAY@(LINE)=TMP
103 S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
104 S LINE=LINE+1
105 Q (LINE-OFFSET)
Note: See TracBrowser for help on using the repository browser.