- VAQBUL01 ;ALB/JRP - BULLETINS;10-MAR-93
- ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
- ERR2USR ;SEND ERROR MESSAGE TO SENDER IF ALL TRANSMISSIONS WHERE NOT SENT
- ; DECLARATIONS TAKEN CARE OF IN GENXMIT^VAQADM50
- S TMP="UNABLE TO SEND MESSAGES"
- S XMZ=$$MAKESTUB^VAQCON1(TMP,"PDX")
- Q:(XMZ<1)
- S LINE=1
- ;PUT IN ERROR MESSAGE
- S TMP="The following message(s) could not be transmitted ..."
- S X=$$ADDLINE^VAQCON1(TMP,XMZ,LINE)
- S LINE=LINE+1
- S TRANS=""
- S ERRNUM=1
- F S TRANS=$O(@ARRAY3@(TRANS)) Q:('TRANS) D
- .F TMP=1:1:2 S X=$$ADDLINE^VAQCON1("",XMZ,LINE),LINE=LINE+1
- .S X=+$G(^VAT(394.61,TRANS,0))
- .S TMP="("_ERRNUM_") Transaction Number: "_X
- .S X=$$ADDLINE^VAQCON1(TMP,XMZ,LINE)
- .S LINE=LINE+1
- .S TMP=$G(^VAT(394.61,TRANS,"QRY"))
- .S X=$$REPEAT^VAQUTL1(" ",($L(ERRNUM)+6))
- .S X=X_"Name: "_$P(TMP,"^",1)
- .S X=$$ADDLINE^VAQCON1(X,XMZ,LINE)
- .S LINE=LINE+1
- .S X=$$REPEAT^VAQUTL1(" ",($L(ERRNUM)+6))
- .S X=X_"PID: "_$P(TMP,"^",4)
- .S X=$$ADDLINE^VAQCON1(X,XMZ,LINE)
- .S LINE=LINE+1
- .S X=$$REPEAT^VAQUTL1(" ",($L(ERRNUM)+6))
- .S X=X_"SSN: "_$P(TMP,"^",2)
- .S X=$$ADDLINE^VAQCON1(X,XMZ,LINE)
- .S LINE=LINE+1
- .S X=$$REPEAT^VAQUTL1(" ",($L(ERRNUM)+6))
- .S X=X_"DOB: "_$$DOBFMT^VAQUTL99($P(TMP,"^",3))
- .S X=$$ADDLINE^VAQCON1(X,XMZ,LINE)
- .S LINE=LINE+1
- .;GET SENDER
- .S TMP=$$SENDER^VAQCON2(TRANS)
- .S X=$$REPEAT^VAQUTL1(" ",($L(ERRNUM)+6))
- .S X=X_"Sent By: "_$P(TMP,"^",1)
- .S X=$$ADDLINE^VAQCON1(X,XMZ,LINE)
- .S LINE=LINE+1
- .;PLACE SENDER IN RECIPIENT LIST
- .S X=+$P(TMP,"^",2)
- .S TMP=$P(TMP,"^",1)
- .S X=$S(((X'=.5)&(X'=0)):X,((TMP'="POSTMASTER")&(TMP'="PDX")&(TMP'="Patient Data eXchange")&(TMP'="")):TMP,1:"")
- .S:(X'="") XMY(X)=""
- .;GET MESSAGE TYPE
- .S TMP=$$STATYPE^VAQCON1(TRANS)
- .S TYPE=$P(TMP,"^",2)
- .S:($P(TMP,"^",1)="-1") TYPE=-1
- .S:(TYPE="ACK") TYPE=$P(TMP,"^",1)
- .;GET DOMAIN & SITE
- .S TMP="Could not be determined (Contact your PDX ADPAC)^Could not be determined (Contact your PDX ADPAC)"
- .S:((TYPE="VAQ-UNACK")!(TYPE="REQ")) TMP=$G(^VAT(394.61,TRANS,"ATHR2"))
- .S:((TYPE="RES")!(TYPE="UNS")!(TYPE="VAQ-RQACK")) TMP=$G(^VAT(394.61,TRANS,"RQST2"))
- .S SITE=$P(TMP,"^",1)
- .S DOMAIN=$P(TMP,"^",2)
- .S X=$$REPEAT^VAQUTL1(" ",($L(ERRNUM)+6))
- .S X=X_"Site: "_SITE
- .S X=$$ADDLINE^VAQCON1(X,XMZ,LINE)
- .S LINE=LINE+1
- .S X=$$REPEAT^VAQUTL1(" ",($L(ERRNUM)+6))
- .S X=X_"Domain: "_DOMAIN
- .S X=$$ADDLINE^VAQCON1(X,XMZ,LINE)
- .S LINE=LINE+1
- .S X=$$REPEAT^VAQUTL1(" ",($L(ERRNUM)+6))
- .S X=X_"Message Type: "
- .S:(TYPE="-1") X=X_"Could not be determined (Contact your PDX ADPAC)"
- .S:(TYPE="REQ") X=X_"PDX Request"
- .S:(TYPE="RES") X=X_"Results from processing an external request"
- .S:(TYPE="UNS") X=X_"Unsolicited PDX"
- .S:((TYPE="VAQ-RQACK")!(TYPE="VAQ-UNACK")) X=X_"Acknowledgment (Contact your PDX ADPAC)"
- .S:(TYPE="RET") X=X_"Re-transmit (Contact your PDX ADPAC)"
- .S TMP=$$ADDLINE^VAQCON1(X,XMZ,LINE)
- .S LINE=LINE+1
- .S ERRNUM=ERRNUM+1
- ;SET ZERO NODE
- S X=$$SETZERO^VAQCON1(XMZ,(LINE-1))
- S XMDUN="Patient Data eXchange"
- D ENT1^XMD
- Q
- ;
- ERR2IRM ;SEND ERROR MESSAGE TO IRM IF ALL TRANSMISSIONS WHERE NOT SENT
- ; DECLARATIONS TAKEN CARE OF IN GENXMIT^VAQADM50
- S TMP="UNABLE TO SEND MESSAGES"
- S XMZ=$$MAKESTUB^VAQCON1(TMP,"PDX")
- Q:(XMZ<1)
- S LINE=1
- ;PUT IN ERROR MESSAGE
- S TMP="The following error(s) occurred while generating PDX transmissions ..."
- S X=$$ADDLINE^VAQCON1(TMP,XMZ,LINE)
- S LINE=LINE+1
- S TRANS=""
- S ERRNUM=1
- F S TRANS=$O(@ARRAY3@(TRANS)) Q:('TRANS) D
- .F TMP=1:1:2 S X=$$ADDLINE^VAQCON1("",XMZ,LINE),LINE=LINE+1
- .S X=+$G(^VAT(394.61,TRANS,0))
- .S TMP="("_ERRNUM_") Transaction Number: "_X
- .S X=$$ADDLINE^VAQCON1(TMP,XMZ,LINE)
- .S LINE=LINE+1
- .S X=$$REPEAT^VAQUTL1(" ",($L(ERRNUM)+6))
- .S X=X_"IFN: "_TRANS
- .S X=$$ADDLINE^VAQCON1(X,XMZ,LINE)
- .S LINE=LINE+1
- .S X=$$REPEAT^VAQUTL1(" ",($L(ERRNUM)+6))
- .S X=X_"Global Location: ^VAT(394.61,"_TRANS_")"
- .S X=$$ADDLINE^VAQCON1(X,XMZ,LINE)
- .S LINE=LINE+1
- .S TMP=$$SENDER^VAQCON2(TRANS)
- .S:(TMP="") TMP="Unknown^??"
- .S X=$$REPEAT^VAQUTL1(" ",($L(ERRNUM)+6))
- .S X=X_"User: "_$P(TMP,"^",1)_" ("_$P(TMP,"^",2)_")"
- .S TMP=$$ADDLINE^VAQCON1(X,XMZ,LINE)
- .S LINE=LINE+1
- .S X=""
- .F S X=$O(@ARRAY3@(TRANS,X)) Q:(X="") D
- ..S TMP=$$REPEAT^VAQUTL1(" ",($L(ERRNUM)+6))
- ..S TMP=TMP_$G(@ARRAY3@(TRANS,X))
- ..S TMP=$$ADDLINE^VAQCON1(TMP,XMZ,LINE)
- ..S LINE=LINE+1
- .S ERRNUM=ERRNUM+1
- ;SET ZERO NODE
- S X=$$SETZERO^VAQCON1(XMZ,(LINE-1))
- ;SEND TO IRM/ERROR GROUP
- S XMY("G.VAQ PDX ERRORS")=""
- S XMDUN="Patient Data eXchange"
- D ENT1^XMD
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQBUL01 4579 printed Feb 18, 2025@23:50:38 Page 2
- VAQBUL01 ;ALB/JRP - BULLETINS;10-MAR-93
- +1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
- ERR2USR ;SEND ERROR MESSAGE TO SENDER IF ALL TRANSMISSIONS WHERE NOT SENT
- +1 ; DECLARATIONS TAKEN CARE OF IN GENXMIT^VAQADM50
- +2 SET TMP="UNABLE TO SEND MESSAGES"
- +3 SET XMZ=$$MAKESTUB^VAQCON1(TMP,"PDX")
- +4 if (XMZ<1)
- QUIT
- +5 SET LINE=1
- +6 ;PUT IN ERROR MESSAGE
- +7 SET TMP="The following message(s) could not be transmitted ..."
- +8 SET X=$$ADDLINE^VAQCON1(TMP,XMZ,LINE)
- +9 SET LINE=LINE+1
- +10 SET TRANS=""
- +11 SET ERRNUM=1
- +12 FOR
- SET TRANS=$ORDER(@ARRAY3@(TRANS))
- if ('TRANS)
- QUIT
- Begin DoDot:1
- +13 FOR TMP=1:1:2
- SET X=$$ADDLINE^VAQCON1("",XMZ,LINE)
- SET LINE=LINE+1
- +14 SET X=+$GET(^VAT(394.61,TRANS,0))
- +15 SET TMP="("_ERRNUM_") Transaction Number: "_X
- +16 SET X=$$ADDLINE^VAQCON1(TMP,XMZ,LINE)
- +17 SET LINE=LINE+1
- +18 SET TMP=$GET(^VAT(394.61,TRANS,"QRY"))
- +19 SET X=$$REPEAT^VAQUTL1(" ",($LENGTH(ERRNUM)+6))
- +20 SET X=X_"Name: "_$PIECE(TMP,"^",1)
- +21 SET X=$$ADDLINE^VAQCON1(X,XMZ,LINE)
- +22 SET LINE=LINE+1
- +23 SET X=$$REPEAT^VAQUTL1(" ",($LENGTH(ERRNUM)+6))
- +24 SET X=X_"PID: "_$PIECE(TMP,"^",4)
- +25 SET X=$$ADDLINE^VAQCON1(X,XMZ,LINE)
- +26 SET LINE=LINE+1
- +27 SET X=$$REPEAT^VAQUTL1(" ",($LENGTH(ERRNUM)+6))
- +28 SET X=X_"SSN: "_$PIECE(TMP,"^",2)
- +29 SET X=$$ADDLINE^VAQCON1(X,XMZ,LINE)
- +30 SET LINE=LINE+1
- +31 SET X=$$REPEAT^VAQUTL1(" ",($LENGTH(ERRNUM)+6))
- +32 SET X=X_"DOB: "_$$DOBFMT^VAQUTL99($PIECE(TMP,"^",3))
- +33 SET X=$$ADDLINE^VAQCON1(X,XMZ,LINE)
- +34 SET LINE=LINE+1
- +35 ;GET SENDER
- +36 SET TMP=$$SENDER^VAQCON2(TRANS)
- +37 SET X=$$REPEAT^VAQUTL1(" ",($LENGTH(ERRNUM)+6))
- +38 SET X=X_"Sent By: "_$PIECE(TMP,"^",1)
- +39 SET X=$$ADDLINE^VAQCON1(X,XMZ,LINE)
- +40 SET LINE=LINE+1
- +41 ;PLACE SENDER IN RECIPIENT LIST
- +42 SET X=+$PIECE(TMP,"^",2)
- +43 SET TMP=$PIECE(TMP,"^",1)
- +44 SET X=$SELECT(((X'=.5)&(X'=0)):X,((TMP'="POSTMASTER")&(TMP'="PDX")&(TMP'="Patient Data eXchange")&(TMP'="")):TMP,1:"")
- +45 if (X'="")
- SET XMY(X)=""
- +46 ;GET MESSAGE TYPE
- +47 SET TMP=$$STATYPE^VAQCON1(TRANS)
- +48 SET TYPE=$PIECE(TMP,"^",2)
- +49 if ($PIECE(TMP,"^",1)="-1")
- SET TYPE=-1
- +50 if (TYPE="ACK")
- SET TYPE=$PIECE(TMP,"^",1)
- +51 ;GET DOMAIN & SITE
- +52 SET TMP="Could not be determined (Contact your PDX ADPAC)^Could not be determined (Contact your PDX ADPAC)"
- +53 if ((TYPE="VAQ-UNACK")!(TYPE="REQ"))
- SET TMP=$GET(^VAT(394.61,TRANS,"ATHR2"))
- +54 if ((TYPE="RES")!(TYPE="UNS")!(TYPE="VAQ-RQACK"))
- SET TMP=$GET(^VAT(394.61,TRANS,"RQST2"))
- +55 SET SITE=$PIECE(TMP,"^",1)
- +56 SET DOMAIN=$PIECE(TMP,"^",2)
- +57 SET X=$$REPEAT^VAQUTL1(" ",($LENGTH(ERRNUM)+6))
- +58 SET X=X_"Site: "_SITE
- +59 SET X=$$ADDLINE^VAQCON1(X,XMZ,LINE)
- +60 SET LINE=LINE+1
- +61 SET X=$$REPEAT^VAQUTL1(" ",($LENGTH(ERRNUM)+6))
- +62 SET X=X_"Domain: "_DOMAIN
- +63 SET X=$$ADDLINE^VAQCON1(X,XMZ,LINE)
- +64 SET LINE=LINE+1
- +65 SET X=$$REPEAT^VAQUTL1(" ",($LENGTH(ERRNUM)+6))
- +66 SET X=X_"Message Type: "
- +67 if (TYPE="-1")
- SET X=X_"Could not be determined (Contact your PDX ADPAC)"
- +68 if (TYPE="REQ")
- SET X=X_"PDX Request"
- +69 if (TYPE="RES")
- SET X=X_"Results from processing an external request"
- +70 if (TYPE="UNS")
- SET X=X_"Unsolicited PDX"
- +71 if ((TYPE="VAQ-RQACK")!(TYPE="VAQ-UNACK"))
- SET X=X_"Acknowledgment (Contact your PDX ADPAC)"
- +72 if (TYPE="RET")
- SET X=X_"Re-transmit (Contact your PDX ADPAC)"
- +73 SET TMP=$$ADDLINE^VAQCON1(X,XMZ,LINE)
- +74 SET LINE=LINE+1
- +75 SET ERRNUM=ERRNUM+1
- End DoDot:1
- +76 ;SET ZERO NODE
- +77 SET X=$$SETZERO^VAQCON1(XMZ,(LINE-1))
- +78 SET XMDUN="Patient Data eXchange"
- +79 DO ENT1^XMD
- +80 QUIT
- +81 ;
- ERR2IRM ;SEND ERROR MESSAGE TO IRM IF ALL TRANSMISSIONS WHERE NOT SENT
- +1 ; DECLARATIONS TAKEN CARE OF IN GENXMIT^VAQADM50
- +2 SET TMP="UNABLE TO SEND MESSAGES"
- +3 SET XMZ=$$MAKESTUB^VAQCON1(TMP,"PDX")
- +4 if (XMZ<1)
- QUIT
- +5 SET LINE=1
- +6 ;PUT IN ERROR MESSAGE
- +7 SET TMP="The following error(s) occurred while generating PDX transmissions ..."
- +8 SET X=$$ADDLINE^VAQCON1(TMP,XMZ,LINE)
- +9 SET LINE=LINE+1
- +10 SET TRANS=""
- +11 SET ERRNUM=1
- +12 FOR
- SET TRANS=$ORDER(@ARRAY3@(TRANS))
- if ('TRANS)
- QUIT
- Begin DoDot:1
- +13 FOR TMP=1:1:2
- SET X=$$ADDLINE^VAQCON1("",XMZ,LINE)
- SET LINE=LINE+1
- +14 SET X=+$GET(^VAT(394.61,TRANS,0))
- +15 SET TMP="("_ERRNUM_") Transaction Number: "_X
- +16 SET X=$$ADDLINE^VAQCON1(TMP,XMZ,LINE)
- +17 SET LINE=LINE+1
- +18 SET X=$$REPEAT^VAQUTL1(" ",($LENGTH(ERRNUM)+6))
- +19 SET X=X_"IFN: "_TRANS
- +20 SET X=$$ADDLINE^VAQCON1(X,XMZ,LINE)
- +21 SET LINE=LINE+1
- +22 SET X=$$REPEAT^VAQUTL1(" ",($LENGTH(ERRNUM)+6))
- +23 SET X=X_"Global Location: ^VAT(394.61,"_TRANS_")"
- +24 SET X=$$ADDLINE^VAQCON1(X,XMZ,LINE)
- +25 SET LINE=LINE+1
- +26 SET TMP=$$SENDER^VAQCON2(TRANS)
- +27 if (TMP="")
- SET TMP="Unknown^??"
- +28 SET X=$$REPEAT^VAQUTL1(" ",($LENGTH(ERRNUM)+6))
- +29 SET X=X_"User: "_$PIECE(TMP,"^",1)_" ("_$PIECE(TMP,"^",2)_")"
- +30 SET TMP=$$ADDLINE^VAQCON1(X,XMZ,LINE)
- +31 SET LINE=LINE+1
- +32 SET X=""
- +33 FOR
- SET X=$ORDER(@ARRAY3@(TRANS,X))
- if (X="")
- QUIT
- Begin DoDot:2
- +34 SET TMP=$$REPEAT^VAQUTL1(" ",($LENGTH(ERRNUM)+6))
- +35 SET TMP=TMP_$GET(@ARRAY3@(TRANS,X))
- +36 SET TMP=$$ADDLINE^VAQCON1(TMP,XMZ,LINE)
- +37 SET LINE=LINE+1
- End DoDot:2
- +38 SET ERRNUM=ERRNUM+1
- End DoDot:1
- +39 ;SET ZERO NODE
- +40 SET X=$$SETZERO^VAQCON1(XMZ,(LINE-1))
- +41 ;SEND TO IRM/ERROR GROUP
- +42 SET XMY("G.VAQ PDX ERRORS")=""
- +43 SET XMDUN="Patient Data eXchange"
- +44 DO ENT1^XMD
- +45 QUIT