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