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