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 Apr 09, 2024@21:27:39 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
