- 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 Feb 18, 2025@23:50:46 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