VAQFIL14 ;ALB/JRP - MESSAGE FILING;12-MAY-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
;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.
;
;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,"COMMENT",1))) "-1^Message did not contain a comment block"
S TRANPTR=+$G(TRANPTR)
Q:(('TRANPTR)!('$D(^VAT(394.61,TRANPTR)))) "-1^Did not pass a valid transaction"
;DECLARE VARIABLES
N TMP,TYPE,LINE,ERR,OFFSET
;MAKE SURE IT'S A COMMENT BLOCK
S TMP=$G(@PARSARR@(MESSNUM,"COMMENT",1,1))
S:(TMP=" ") TMP=""
Q:((TMP="")!(TMP'="$COMMENT")) "-1^Not a comment block"
S TMP=$G(@PARSARR@(MESSNUM,"COMMENT",1,2))
Q:(TMP="$$COMMENT") 0
;GET MESSAGE TYPE
S TMP=$$STATYPE^VAQFIL11(MESSNUM,PARSARR)
Q:($P(TMP,"^",1)="-1") "-1^Could not determine message type"
S TYPE=$P(TMP,"^",2)
;ACK & RETRANSMIT & REQUEST DON'T HAVE COMMENT BLOCK
Q:((TYPE="ACK")!(TYPE="RET")!(TYPE="REQ")) "-1^Message type does not require comment block"
;DELETE EXISTING COMMENT
S ERR=0
I ($D(^VAT(394.61,TRANPTR,"CMNT"))) D
.S ERR=$$FILEINFO^VAQFILE(394.61,TRANPTR,100,"@")
Q:(ERR) "-1^Unable to delete existing comment"
;PUT BLANK LINE INTO COMMENT (SETS ZERO NODE)
S ERR=$$FILEINFO^VAQFILE(394.61,TRANPTR,100," ")
Q:(ERR) "-1^Unable to store comment"
;STORE COMMENT
S LINE=1
S OFFSET=1
S TMP=""
F S OFFSET=$O(@PARSARR@(MESSNUM,"COMMENT",1,OFFSET)) Q:(OFFSET="") D Q:(TMP="$$COMMENT")
.S TMP=$G(@PARSARR@(MESSNUM,"COMMENT",1,OFFSET))
.Q:(TMP="$$COMMENT")
.S ^VAT(394.61,TRANPTR,"CMNT",LINE,0)=TMP
.S LINE=LINE+1
I (TMP'="$$COMMENT") S ERR=$$FILEINFO^VAQFILE(394.61,TRANPTR,100,"@") Q "-1^Not a valid comment"
;UPDATE ZERO NODE
S LINE=LINE-1
S TMP=$G(^VAT(394.61,TRANPTR,"CMNT",0))
S $P(TMP,"^",3)=LINE
S $P(TMP,"^",4)=LINE
S ^VAT(394.61,TRANPTR,"CMNT",0)=TMP
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQFIL14 2438 printed Apr 09, 2024@21:28:19 Page 2
VAQFIL14 ;ALB/JRP - MESSAGE FILING;12-MAY-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
+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 ;CHECK INPUT
+13 if ($GET(MESSNUM)="")
SET MESSNUM=1
+14 if ($GET(PARSARR)="")
QUIT "-1^Did not pass reference to parsing array"
+15 if ('$DATA(@PARSARR@(MESSNUM)))
QUIT "-1^Did not pass valid message number"
+16 if ('$DATA(@PARSARR@(MESSNUM,"COMMENT",1)))
QUIT "-1^Message did not contain a comment block"
+17 SET TRANPTR=+$GET(TRANPTR)
+18 if (('TRANPTR)!('$DATA(^VAT(394.61,TRANPTR))))
QUIT "-1^Did not pass a valid transaction"
+19 ;DECLARE VARIABLES
+20 NEW TMP,TYPE,LINE,ERR,OFFSET
+21 ;MAKE SURE IT'S A COMMENT BLOCK
+22 SET TMP=$GET(@PARSARR@(MESSNUM,"COMMENT",1,1))
+23 if (TMP=" ")
SET TMP=""
+24 if ((TMP="")!(TMP'="$COMMENT"))
QUIT "-1^Not a comment block"
+25 SET TMP=$GET(@PARSARR@(MESSNUM,"COMMENT",1,2))
+26 if (TMP="$$COMMENT")
QUIT 0
+27 ;GET MESSAGE TYPE
+28 SET TMP=$$STATYPE^VAQFIL11(MESSNUM,PARSARR)
+29 if ($PIECE(TMP,"^",1)="-1")
QUIT "-1^Could not determine message type"
+30 SET TYPE=$PIECE(TMP,"^",2)
+31 ;ACK & RETRANSMIT & REQUEST DON'T HAVE COMMENT BLOCK
+32 if ((TYPE="ACK")!(TYPE="RET")!(TYPE="REQ"))
QUIT "-1^Message type does not require comment block"
+33 ;DELETE EXISTING COMMENT
+34 SET ERR=0
+35 IF ($DATA(^VAT(394.61,TRANPTR,"CMNT")))
Begin DoDot:1
+36 SET ERR=$$FILEINFO^VAQFILE(394.61,TRANPTR,100,"@")
End DoDot:1
+37 if (ERR)
QUIT "-1^Unable to delete existing comment"
+38 ;PUT BLANK LINE INTO COMMENT (SETS ZERO NODE)
+39 SET ERR=$$FILEINFO^VAQFILE(394.61,TRANPTR,100," ")
+40 if (ERR)
QUIT "-1^Unable to store comment"
+41 ;STORE COMMENT
+42 SET LINE=1
+43 SET OFFSET=1
+44 SET TMP=""
+45 FOR
SET OFFSET=$ORDER(@PARSARR@(MESSNUM,"COMMENT",1,OFFSET))
if (OFFSET="")
QUIT
Begin DoDot:1
+46 SET TMP=$GET(@PARSARR@(MESSNUM,"COMMENT",1,OFFSET))
+47 if (TMP="$$COMMENT")
QUIT
+48 SET ^VAT(394.61,TRANPTR,"CMNT",LINE,0)=TMP
+49 SET LINE=LINE+1
End DoDot:1
if (TMP="$$COMMENT")
QUIT
+50 IF (TMP'="$$COMMENT")
SET ERR=$$FILEINFO^VAQFILE(394.61,TRANPTR,100,"@")
QUIT "-1^Not a valid comment"
+51 ;UPDATE ZERO NODE
+52 SET LINE=LINE-1
+53 SET TMP=$GET(^VAT(394.61,TRANPTR,"CMNT",0))
+54 SET $PIECE(TMP,"^",3)=LINE
+55 SET $PIECE(TMP,"^",4)=LINE
+56 SET ^VAT(394.61,TRANPTR,"CMNT",0)=TMP
+57 QUIT 0
