VistA-WorldVistAEHR/r/PATIENT_DATA_EXCHANGE-VAQ/VAQBUL01.m

131 lines
4.3 KiB
Mathematica

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