VAQCON1 ;ALB/JRP - MESSAGE CONSTRUCTION;9-APR-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
MAKESTUB(XMSUB,XMDUZ) ;CREATE STUB MAILMAN MESSAGE
;INPUT : XMSUB - Subject of message
; XMDUZ - Sender of message; Pointer to NEW PERSON file
; or text to be used as the sender (defaults to DUZ)
;OUTPUT : XMZ - Message number
; -1^Error_Text - Error
;
;CHECK INPUT
Q:($G(XMSUB)="") "-1^Subject of message not passed"
S:($G(XMDUZ)="") XMDUZ=$G(DUZ)
Q:(XMDUZ="") "-1^Could not determine sender of message"
;DECLARE VARIABLES
N XMZ
;CREATE STUB
D XMZ^XMA2
S:(XMZ<1) XMZ="-1^Could not create stub message"
Q XMZ
;
ADDLINE(TEXT,MESSAGE,LINE) ;ADD LINE OF TEXT TO MESSAGE
;INPUT : TEXT - Line of text to add
; MESSAGE - Message number
; LINE - Line number
;OUTPUT : 0 - Success
; -1^Error_Text - Error
;NOTES : NULL lines of text will be converted to <SPACE>
;
;CHECK INPUT
S:($G(TEXT)="") TEXT=" "
S MESSAGE=+$G(MESSAGE)
Q:(('MESSAGE)!('$D(^XMB(3.9,MESSAGE)))) "-1^Valid message number not passed"
Q:('(+$G(LINE))) "-1^Line number not passed"
;INSERT TEXT
S ^XMB(3.9,MESSAGE,2,LINE,0)=TEXT
Q 0
;
KILLSTUB(XMZ) ;DELETE STUB MESSAGE
;INPUT : XMZ - Message number
;OUTPUT : 0 - "Success"
; -1^Error_Text - Message number not passed
;NOTE : This should be used when errors occur while building
; message
;
;CHECK INPUT
S XMZ=+$G(XMZ)
Q:(('XMZ)!('$D(^XMB(3.9,XMZ)))) "-1^Valid message number not passed"
;DECLARE VARIABLES
N XMDUN,XMY,TMP,ZTSK,ZTRTN,ZTDESC,ZTDTH,ZTSAVE
;SET ZERO NODE
S TMP=$$SETZERO(XMZ,0)
;SEND MESSAGE TO POSTMASTER
S XMDUN="Patient Data eXchange"
S XMY(.5)=""
D ENT1^XMD
;DELETE MESSAGE FROM POSTMASTER'S BASKET
;THIS IS TASKED TO GIVE TIME FOR MESSAGE DELIVERY
S ZTRTN="KILLMES^VAQCON1"
S ZTDESC="Killing of bad PDX messages"
S ZTDTH=$H
S ZTSAVE("XMZ")=XMZ
S ZTSAVE("XMDUZ")=.5
D ^%ZTLOAD
I ('$D(ZTSK)) Q "-1^Could not task deletion of message"
Q 0
;
KILLMES ;KILL MESSAGES (TASKED)
;INPUT : XMK - Basket number (optional)
; XMZ - Message number
; XMDUZ - User's DUZ
;OUTPUT : None
;NOTE : This is used to delete the message by KILLSTUB
; : All input variables are deleted upon exit
;
;CHECK INPUT
I (('$G(XMZ))!('$G(XMDUZ))) K XMK,XMZ,XMDUZ Q
;KILL MESSAGE
D KLQ^XMA1B
K XMK,XMZ,XMDUZ
S:($D(ZTQUEUED)) ZTREQ="@"
Q
SETZERO(MESSAGE,LINES) ;SET ZERO NODE OF MAILMAN MESSAGE
;INPUT : MESSAGE - Message number
; LINES - Number of lines in message (defaults to 0)
;OUTPUT : 0 - Success
; -1^Error_Text - Error
;
;CHECK INPUT
S MESSAGE=+$G(MESSAGE)
Q:(('MESSAGE)!('$D(^XMB(3.9,MESSAGE)))) "-1^Valid message number not passed"
S LINES=+$G(LINES)
;SET ZERO NODE
S ^XMB(3.9,MESSAGE,2,0)="^3.92A^"_LINES_"^"_LINES_"^"_+$G(DT)
Q 0
;
STATYPE(TRAN,CURRENT) ;DETERMINE MESSAGE STATUS & TYPE OF TRANSACTION
;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
; CURRENT - Flag indicating if which status to use
; If 0, return release status (default)
; If 1, return current status
;OUTPUT : Message_Status^Message_Type - Success
; -1^Error_Text - Error
;CHECK INPUT
Q:('(+$G(TRAN))) "-1^Did not pass pointer to VAQ - TRANSACTION file"
S CURRENT=+$G(CURRENT)
;DECLARE VARIABLES
N TMP,STATUS,TYPE
S TMP=$G(^VAT(394.61,TRAN,0))
Q:(TMP="") "-1^Did not pass a valid transaction"
S:(CURRENT) TMP=+$P(TMP,"^",2)
S:('CURRENT) TMP=+$P(TMP,"^",5)
Q:('TMP) "-1^Could not determine status of message"
S STATUS=$P($G(^VAT(394.85,TMP,0)),"^",1)
Q:(STATUS="") "-1^Could not determine status of message"
;DETERMINE MESSAGE TYPE
S TYPE=0
S:((STATUS="VAQ-TUNSL")!(STATUS="VAQ-PROC")) TYPE=""
S:(STATUS="VAQ-RQST") TYPE="REQ"
S:((STATUS="VAQ-AMBIG")!(STATUS="VAQ-AUTO")!(STATUS="VAQ-NTFND")!(STATUS="VAQ-REJ")!(STATUS="VAQ-RSLT")) TYPE="RES"
S:(STATUS="VAQ-UNSOL") TYPE="UNS"
S:((STATUS="VAQ-RQACK")!(STATUS="VAQ-UNACK")) TYPE="ACK"
S:(STATUS="VAQ-RTRNS") TYPE="RET"
S:(STATUS="VAQ-RCVE") TYPE="REC"
Q:(TYPE=0) "-1^Could not determine message type"
Q STATUS_"^"_TYPE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQCON1 4245 printed Sep 23, 2025@20:00:23 Page 2
VAQCON1 ;ALB/JRP - MESSAGE CONSTRUCTION;9-APR-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
MAKESTUB(XMSUB,XMDUZ) ;CREATE STUB MAILMAN MESSAGE
+1 ;INPUT : XMSUB - Subject of message
+2 ; XMDUZ - Sender of message; Pointer to NEW PERSON file
+3 ; or text to be used as the sender (defaults to DUZ)
+4 ;OUTPUT : XMZ - Message number
+5 ; -1^Error_Text - Error
+6 ;
+7 ;CHECK INPUT
+8 if ($GET(XMSUB)="")
QUIT "-1^Subject of message not passed"
+9 if ($GET(XMDUZ)="")
SET XMDUZ=$GET(DUZ)
+10 if (XMDUZ="")
QUIT "-1^Could not determine sender of message"
+11 ;DECLARE VARIABLES
+12 NEW XMZ
+13 ;CREATE STUB
+14 DO XMZ^XMA2
+15 if (XMZ<1)
SET XMZ="-1^Could not create stub message"
+16 QUIT XMZ
+17 ;
ADDLINE(TEXT,MESSAGE,LINE) ;ADD LINE OF TEXT TO MESSAGE
+1 ;INPUT : TEXT - Line of text to add
+2 ; MESSAGE - Message number
+3 ; LINE - Line number
+4 ;OUTPUT : 0 - Success
+5 ; -1^Error_Text - Error
+6 ;NOTES : NULL lines of text will be converted to <SPACE>
+7 ;
+8 ;CHECK INPUT
+9 if ($GET(TEXT)="")
SET TEXT=" "
+10 SET MESSAGE=+$GET(MESSAGE)
+11 if (('MESSAGE)!('$DATA(^XMB(3.9,MESSAGE))))
QUIT "-1^Valid message number not passed"
+12 if ('(+$GET(LINE)))
QUIT "-1^Line number not passed"
+13 ;INSERT TEXT
+14 SET ^XMB(3.9,MESSAGE,2,LINE,0)=TEXT
+15 QUIT 0
+16 ;
KILLSTUB(XMZ) ;DELETE STUB MESSAGE
+1 ;INPUT : XMZ - Message number
+2 ;OUTPUT : 0 - "Success"
+3 ; -1^Error_Text - Message number not passed
+4 ;NOTE : This should be used when errors occur while building
+5 ; message
+6 ;
+7 ;CHECK INPUT
+8 SET XMZ=+$GET(XMZ)
+9 if (('XMZ)!('$DATA(^XMB(3.9,XMZ))))
QUIT "-1^Valid message number not passed"
+10 ;DECLARE VARIABLES
+11 NEW XMDUN,XMY,TMP,ZTSK,ZTRTN,ZTDESC,ZTDTH,ZTSAVE
+12 ;SET ZERO NODE
+13 SET TMP=$$SETZERO(XMZ,0)
+14 ;SEND MESSAGE TO POSTMASTER
+15 SET XMDUN="Patient Data eXchange"
+16 SET XMY(.5)=""
+17 DO ENT1^XMD
+18 ;DELETE MESSAGE FROM POSTMASTER'S BASKET
+19 ;THIS IS TASKED TO GIVE TIME FOR MESSAGE DELIVERY
+20 SET ZTRTN="KILLMES^VAQCON1"
+21 SET ZTDESC="Killing of bad PDX messages"
+22 SET ZTDTH=$HOROLOG
+23 SET ZTSAVE("XMZ")=XMZ
+24 SET ZTSAVE("XMDUZ")=.5
+25 DO ^%ZTLOAD
+26 IF ('$DATA(ZTSK))
QUIT "-1^Could not task deletion of message"
+27 QUIT 0
+28 ;
KILLMES ;KILL MESSAGES (TASKED)
+1 ;INPUT : XMK - Basket number (optional)
+2 ; XMZ - Message number
+3 ; XMDUZ - User's DUZ
+4 ;OUTPUT : None
+5 ;NOTE : This is used to delete the message by KILLSTUB
+6 ; : All input variables are deleted upon exit
+7 ;
+8 ;CHECK INPUT
+9 IF (('$GET(XMZ))!('$GET(XMDUZ)))
KILL XMK,XMZ,XMDUZ
QUIT
+10 ;KILL MESSAGE
+11 DO KLQ^XMA1B
+12 KILL XMK,XMZ,XMDUZ
+13 if ($DATA(ZTQUEUED))
SET ZTREQ="@"
+14 QUIT
SETZERO(MESSAGE,LINES) ;SET ZERO NODE OF MAILMAN MESSAGE
+1 ;INPUT : MESSAGE - Message number
+2 ; LINES - Number of lines in message (defaults to 0)
+3 ;OUTPUT : 0 - Success
+4 ; -1^Error_Text - Error
+5 ;
+6 ;CHECK INPUT
+7 SET MESSAGE=+$GET(MESSAGE)
+8 if (('MESSAGE)!('$DATA(^XMB(3.9,MESSAGE))))
QUIT "-1^Valid message number not passed"
+9 SET LINES=+$GET(LINES)
+10 ;SET ZERO NODE
+11 SET ^XMB(3.9,MESSAGE,2,0)="^3.92A^"_LINES_"^"_LINES_"^"_+$GET(DT)
+12 QUIT 0
+13 ;
STATYPE(TRAN,CURRENT) ;DETERMINE MESSAGE STATUS & TYPE OF TRANSACTION
+1 ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
+2 ; CURRENT - Flag indicating if which status to use
+3 ; If 0, return release status (default)
+4 ; If 1, return current status
+5 ;OUTPUT : Message_Status^Message_Type - Success
+6 ; -1^Error_Text - Error
+7 ;CHECK INPUT
+8 if ('(+$GET(TRAN)))
QUIT "-1^Did not pass pointer to VAQ - TRANSACTION file"
+9 SET CURRENT=+$GET(CURRENT)
+10 ;DECLARE VARIABLES
+11 NEW TMP,STATUS,TYPE
+12 SET TMP=$GET(^VAT(394.61,TRAN,0))
+13 if (TMP="")
QUIT "-1^Did not pass a valid transaction"
+14 if (CURRENT)
SET TMP=+$PIECE(TMP,"^",2)
+15 if ('CURRENT)
SET TMP=+$PIECE(TMP,"^",5)
+16 if ('TMP)
QUIT "-1^Could not determine status of message"
+17 SET STATUS=$PIECE($GET(^VAT(394.85,TMP,0)),"^",1)
+18 if (STATUS="")
QUIT "-1^Could not determine status of message"
+19 ;DETERMINE MESSAGE TYPE
+20 SET TYPE=0
+21 if ((STATUS="VAQ-TUNSL")!(STATUS="VAQ-PROC"))
SET TYPE=""
+22 if (STATUS="VAQ-RQST")
SET TYPE="REQ"
+23 if ((STATUS="VAQ-AMBIG")!(STATUS="VAQ-AUTO")!(STATUS="VAQ-NTFND")!(STATUS="VAQ-REJ")!(STATUS="VAQ-RSLT"))
SET TYPE="RES"
+24 if (STATUS="VAQ-UNSOL")
SET TYPE="UNS"
+25 if ((STATUS="VAQ-RQACK")!(STATUS="VAQ-UNACK"))
SET TYPE="ACK"
+26 if (STATUS="VAQ-RTRNS")
SET TYPE="RET"
+27 if (STATUS="VAQ-RCVE")
SET TYPE="REC"
+28 if (TYPE=0)
QUIT "-1^Could not determine message type"
+29 QUIT STATUS_"^"_TYPE
