- 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 Feb 18, 2025@23:51:52 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