source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQCON94.m@ 1147

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1VAQCON94 ;ALB/JRP - MESSAGE CONSTRUCTION;22-APR-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3XMIT10(TRANPTR,MESSNUM,ARRAY,OFFSET) ;BUILD A 1.0 MESSAGE
4 ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file (full global ref)
5 ; MESSNUM - Message number to place message into
6 ; (if 0, message will be placed in ARRAY)
7 ; ARRAY - Array to store message in (full global reference)
8 ; OFFSET - Where to begin placing information (defaults to 0)
9 ;OUTPUT : N - Number of lines in message
10 ; -1^Error_Text - Error
11 ;NOTES : If MESSNUM=0, then the message will be placed into
12 ; ARRAY(LineNumber)=Line_of_info
13 ; If MESSNUM>0 then the message will be placed into
14 ; ^XMB(3.9,MESSNUM,2,LineNumber,0)=Line_of_info
15 ; : The first subscript in ROOT must be a pointer to the
16 ; transaction. The second subscript in ROOT must be the
17 ; segment abbreviation. This is required to identify the
18 ; segments for the transaction.
19 ; ROOT(TransactionPointer,SegmentAbbreviation)
20 ; : Segments required for a 1.0 message will be extracted by
21 ; this routine. This is done to ensure that encryption has
22 ; been turned off.
23 ;
24 ;CHECK INPUT
25 Q:('(+$G(TRANPTR))) "-1^Did not pass pointer to VAQ - TRANSACTION file"
26 S MESSNUM=+$G(MESSNUM)
27 I (('MESSNUM)&($G(ARRAY)="")) Q "-1^Did not pass message number or reference to output array"
28 I (MESSNUM) Q:('$D(^XMB(3.9,MESSNUM))) "-1^Valid message number not passed"
29 S OFFSET=+$G(OFFSET)
30 N TMP,DFN,SEGPTR,LINE,VAQIGNC,ROOT,STATUS,TYPE
31 K ^TMP("VAQ-10",$J)
32 S LINE=OFFSET
33 ;IGNORE ENCRYPTION RULES (1.0 DOES NOT SUPPORT IT)
34 S VAQIGNC=1
35 ;GET STATUS
36 S TMP=$$STATYPE^VAQCON1(TRANPTR)
37 S STATUS=$P(TMP,"^",1)
38 S TYPE=$P(TMP,"^",2)
39 Q:(STATUS="-1") TMP
40 Q:((STATUS="VAQ-AUTO")!(STATUS="VAQ-PROC")!(STATUS="VAQ-TUNSL")) "-1^Transaction does not require a PDX message in version 1.0"
41 Q:((STATUS="VAQ-RTRNS")!(STATUS="VAQ-UNACK")) "-1^Transmission does not have a version 1.0 equivalent"
42 Q:(TYPE="REC") "-1^Transaction is being received, not transmitted"
43 ;GET PATIENT
44 S DFN=+$P($G(^VAT(394.61,TRANPTR,0)),"^",3)
45 I ((STATUS="VAQ-RSLT")!(STATUS="VAQ-UNSOL")) Q:('DFN) "-1^Transaction did not contain pointer to PATIENT file"
46 ;EXTRACT INFORMATION (IF NEEDED)
47 I ((STATUS="VAQ-RSLT")!(STATUS="VAQ-UNSOL")) D
48 .;EXTRACT MINIMUM DATA
49 .S ROOT="^TMP(""VAQ-10"",$J,""PDX*MIN"")"
50 .S SEGPTR=$O(^VAT(394.71,"C","PDX*MIN",""))
51 .S TMP=$$SEGXTRCT^VAQDBI(TRANPTR,"",ROOT,SEGPTR)
52 .Q:(TMP<0)
53 .;EXTRACT MAS DATA
54 .S ROOT="^TMP(""VAQ-10"",$J,""PDX*MAS"")"
55 .S SEGPTR=$O(^VAT(394.71,"C","PDX*MAS",""))
56 .S TMP=$$SEGXTRCT^VAQDBI(TRANPTR,"",ROOT,SEGPTR)
57 .Q:(TMP<0)
58 .;EXTRACT PHARMACY DATA
59 .S ROOT="^TMP(""VAQ-10"",$J,""PDX*MPL"")"
60 .S SEGPTR=$O(^VAT(394.71,"C","PDX*MPL",""))
61 .S TMP=$$SEGXTRCT^VAQDBI(TRANPTR,"",ROOT,SEGPTR)
62 I (TMP<0) K ^TMP("VAQ-10",$J) Q TMP
63 ;BUILD HEADER BLOCK
64 S TMP=$$HEAD10^VAQCON99(TRANPTR,MESSNUM,ARRAY,LINE)
65 I (TMP<0) K ^TMP("VAQ-10",$J) Q TMP
66 S LINE=LINE+TMP
67 ;BUILD DATA BLOCKS
68 S ROOT="^TMP(""VAQ-10"",$J)"
69 I ((STATUS="VAQ-RSLT")!(STATUS="VAQ-UNSOL")) D
70 .S TMP=$$DATA10^VAQCON97(TRANPTR,ROOT,MESSNUM,ARRAY,LINE)
71 .Q:(TMP<0)
72 .S LINE=LINE+TMP
73 I (TMP<0) K ^TMP("VAQ-10",$J) Q TMP
74 K ^TMP("VAQ-10",$J)
75 Q (LINE-OFFSET)
Note: See TracBrowser for help on using the repository browser.