VAQFIL16 ;ALB/JRP - MESSAGE FILING;14-MAY-93
;;1.5;PATIENT DATA EXCHANGE;**4,16,20**;NOV 17, 1993
SEGMENT(MESSNUM,PARSARR,TRANPTR) ;FILE SEGMENT BLOCK
;INPUT : MESSNUM - Message number in transmission (not XMZ)
; (defaults to 1)
; PARSARR - Parsing array (full global reference)
; TRANPTR - Pointer to VAQ - TRANSACTION file
; (As defined by MailMan)
; XMFROM, XMREC,XMZ
;OUTPUT : 0 - Success
; -1^Error_Text - Error
;NOTES : It is the responsibility of the calling program to correct
; the transaction being updated if an error occurs.
;
N VAQCSEG
;CHECK INPUT
S:($G(MESSNUM)="") MESSNUM=1
Q:($G(PARSARR)="") "-1^Did not pass reference to parsing array"
Q:('$D(@PARSARR@(MESSNUM))) "-1^Did not pass valid message number"
Q:('$D(@PARSARR@(MESSNUM,"PATIENT",1))) "-1^Message did not contain a patient block"
S TRANPTR=+$G(TRANPTR)
Q:(('TRANPTR)!('$D(^VAT(394.61,TRANPTR)))) "-1^Did not pass a valid transaction"
;DECLARE VARIABLES
N TMP,ERR,SEGMENT,OFFSET,TMPARR,TIMLIM,OCCLIM
S TMPARR="^TMP(""VAQ-TMP"","_$J_")"
K @TMPARR
;MAKE SURE IT'S A SEGMENT BLOCK
S TMP=$G(@PARSARR@(MESSNUM,"SEGMENT",1,1))
S:(TMP=" ") TMP=""
Q:((TMP="")!(TMP'="$SEGMENT")) "-1^Not a segment block"
;DETERMINE SEGMENTS ALREADY IN TRANSACTION
S TMP=""
F S TMP=$O(^VAT(394.61,TRANPTR,"SEG","B",TMP)) Q:(TMP="") D
.S SEGMENT=$P($G(^VAT(394.71,TMP,0)),"^",1)
;FILE SEGMENTS
S OFFSET=1
S TMP=""
F S OFFSET=$O(@PARSARR@(MESSNUM,"SEGMENT",1,OFFSET)) Q:(OFFSET="") D Q:((TMP="$$SEGMENT")!(OFFSET=""))
.S TMP=$G(@PARSARR@(MESSNUM,"SEGMENT",1,OFFSET))
.Q:(TMP="$$SEGMENT")
.S:(TMP=" ") TMP=""
.Q:(TMP="")
.;CONVERT ABBREVIATION TO POINTER
.S SEGMENT=+$O(^VAT(394.71,"C",TMP,""))
.Q:('SEGMENT)
.Q:($P($G(^VAT(394.71,SEGMENT,0)),"^",1)="")
.S VAQCSEG=SEGMENT,SEGMENT="`"_SEGMENT
.;S VAQCSEG=$P(^VAT(394.71,SEGMENT,0),"^"),SEGMENT="`"_SEGMENT
.;GET TIME LIMIT
.S OFFSET=$O(@PARSARR@(MESSNUM,"SEGMENT",1,OFFSET)) Q:(OFFSET="")
.S TMP=$G(@PARSARR@(MESSNUM,"SEGMENT",1,OFFSET))
.Q:(TMP="$$SEGMENT")
.S:(TMP=" ") TMP=""
.;LIMITS NOT PASSED (BACK UP A LINE)
.I (TMP'="") I (+$O(^VAT(394.71,"C",TMP,""))) S OFFSET=OFFSET-1 Q
.S TIMLIM=TMP
.;GET OCCURRENCE LIMIT (NEXT LINE IN MESSAGE)
.S OFFSET=$O(@PARSARR@(MESSNUM,"SEGMENT",1,OFFSET)) Q:(OFFSET="")
.S TMP=$G(@PARSARR@(MESSNUM,"SEGMENT",1,OFFSET))
.Q:(TMP="$$SEGMENT")
.S:(TMP=" ") TMP=""
.S OCCLIM=TMP
.;FILE NAME, TIME AND OCCURRENCE LIMITS
.S ERR=$$FILESEG^VAQFILE2(394.61,TRANPTR,80,VAQCSEG,TIMLIM,OCCLIM)
I (TMP'="$$SEGMENT") K @TMPARR Q "-1^Not a valid segment block"
;DON'T DELETE SEGMENTS
K @TMPARR Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQFIL16 2722 printed Sep 02, 2024@19:11:11 Page 2
VAQFIL16 ;ALB/JRP - MESSAGE FILING;14-MAY-93
+1 ;;1.5;PATIENT DATA EXCHANGE;**4,16,20**;NOV 17, 1993
SEGMENT(MESSNUM,PARSARR,TRANPTR) ;FILE SEGMENT BLOCK
+1 ;INPUT : MESSNUM - Message number in transmission (not XMZ)
+2 ; (defaults to 1)
+3 ; PARSARR - Parsing array (full global reference)
+4 ; TRANPTR - Pointer to VAQ - TRANSACTION file
+5 ; (As defined by MailMan)
+6 ; XMFROM, XMREC,XMZ
+7 ;OUTPUT : 0 - Success
+8 ; -1^Error_Text - Error
+9 ;NOTES : It is the responsibility of the calling program to correct
+10 ; the transaction being updated if an error occurs.
+11 ;
+12 NEW VAQCSEG
+13 ;CHECK INPUT
+14 if ($GET(MESSNUM)="")
SET MESSNUM=1
+15 if ($GET(PARSARR)="")
QUIT "-1^Did not pass reference to parsing array"
+16 if ('$DATA(@PARSARR@(MESSNUM)))
QUIT "-1^Did not pass valid message number"
+17 if ('$DATA(@PARSARR@(MESSNUM,"PATIENT",1)))
QUIT "-1^Message did not contain a patient block"
+18 SET TRANPTR=+$GET(TRANPTR)
+19 if (('TRANPTR)!('$DATA(^VAT(394.61,TRANPTR))))
QUIT "-1^Did not pass a valid transaction"
+20 ;DECLARE VARIABLES
+21 NEW TMP,ERR,SEGMENT,OFFSET,TMPARR,TIMLIM,OCCLIM
+22 SET TMPARR="^TMP(""VAQ-TMP"","_$JOB_")"
+23 KILL @TMPARR
+24 ;MAKE SURE IT'S A SEGMENT BLOCK
+25 SET TMP=$GET(@PARSARR@(MESSNUM,"SEGMENT",1,1))
+26 if (TMP=" ")
SET TMP=""
+27 if ((TMP="")!(TMP'="$SEGMENT"))
QUIT "-1^Not a segment block"
+28 ;DETERMINE SEGMENTS ALREADY IN TRANSACTION
+29 SET TMP=""
+30 FOR
SET TMP=$ORDER(^VAT(394.61,TRANPTR,"SEG","B",TMP))
if (TMP="")
QUIT
Begin DoDot:1
+31 SET SEGMENT=$PIECE($GET(^VAT(394.71,TMP,0)),"^",1)
End DoDot:1
+32 ;FILE SEGMENTS
+33 SET OFFSET=1
+34 SET TMP=""
+35 FOR
SET OFFSET=$ORDER(@PARSARR@(MESSNUM,"SEGMENT",1,OFFSET))
if (OFFSET="")
QUIT
Begin DoDot:1
+36 SET TMP=$GET(@PARSARR@(MESSNUM,"SEGMENT",1,OFFSET))
+37 if (TMP="$$SEGMENT")
QUIT
+38 if (TMP=" ")
SET TMP=""
+39 if (TMP="")
QUIT
+40 ;CONVERT ABBREVIATION TO POINTER
+41 SET SEGMENT=+$ORDER(^VAT(394.71,"C",TMP,""))
+42 if ('SEGMENT)
QUIT
+43 if ($PIECE($GET(^VAT(394.71,SEGMENT,0)),"^",1)="")
QUIT
+44 SET VAQCSEG=SEGMENT
SET SEGMENT="`"_SEGMENT
+45 ;S VAQCSEG=$P(^VAT(394.71,SEGMENT,0),"^"),SEGMENT="`"_SEGMENT
+46 ;GET TIME LIMIT
+47 SET OFFSET=$ORDER(@PARSARR@(MESSNUM,"SEGMENT",1,OFFSET))
if (OFFSET="")
QUIT
+48 SET TMP=$GET(@PARSARR@(MESSNUM,"SEGMENT",1,OFFSET))
+49 if (TMP="$$SEGMENT")
QUIT
+50 if (TMP=" ")
SET TMP=""
+51 ;LIMITS NOT PASSED (BACK UP A LINE)
+52 IF (TMP'="")
IF (+$ORDER(^VAT(394.71,"C",TMP,"")))
SET OFFSET=OFFSET-1
QUIT
+53 SET TIMLIM=TMP
+54 ;GET OCCURRENCE LIMIT (NEXT LINE IN MESSAGE)
+55 SET OFFSET=$ORDER(@PARSARR@(MESSNUM,"SEGMENT",1,OFFSET))
if (OFFSET="")
QUIT
+56 SET TMP=$GET(@PARSARR@(MESSNUM,"SEGMENT",1,OFFSET))
+57 if (TMP="$$SEGMENT")
QUIT
+58 if (TMP=" ")
SET TMP=""
+59 SET OCCLIM=TMP
+60 ;FILE NAME, TIME AND OCCURRENCE LIMITS
+61 SET ERR=$$FILESEG^VAQFILE2(394.61,TRANPTR,80,VAQCSEG,TIMLIM,OCCLIM)
End DoDot:1
if ((TMP="$$SEGMENT")!(OFFSET=""))
QUIT
+62 IF (TMP'="$$SEGMENT")
KILL @TMPARR
QUIT "-1^Not a valid segment block"
+63 ;DON'T DELETE SEGMENTS
+64 KILL @TMPARR
QUIT 0
