130 lines
4.6 KiB
Mathematica
130 lines
4.6 KiB
Mathematica
PRCVREA ;WOIFO/VC-Transmit HL7 message to IFCAP for RIL(cont);11/24/03 ; 4/26/05 2:42pm
|
|
;;5.1;IFCAP;**81**;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified
|
|
;
|
|
CALLIT ;Call the IFCAP RIL build Routine
|
|
;
|
|
D EN^PRCVRC1(PRCSUB)
|
|
;
|
|
SETUP S PRCHD(1)=""
|
|
S PRCHD(2)="ORC"_PRCCS_PRCCS_3
|
|
S PRCHD(2,"T")="FUND CONTROL POINT"
|
|
S PRCHD(3)="ORC"_PRCCS_PRCCS_17
|
|
S PRCHD(3,"T")="COST CENTER"
|
|
S PRCHD(4)=""
|
|
S PRCHD(5)="ORC"_PRCCS_PRCCS_21
|
|
S PRCHD(5,"T")="SITE NUMBER"
|
|
S PRCHD(6)=""
|
|
S PRCHD(7)="ORC"_PRCCS_PRCCS_10
|
|
S PRCHD(7,"T")="DUZ"
|
|
S PRCHD(8)="ORC"_PRCCS_PRCCS_10
|
|
S PRCHD(8,"T")="LAST NAME"
|
|
S PRCHD(9)="ORC"_PRCCS_PRCCS_11
|
|
S PRCHD(9,"T")="FIRST NAME"
|
|
S PRCDET(1)="RQD"_PRCCS_PRCCS_3
|
|
S PRCDET(1,"T")="ITEM NUMBER"
|
|
S PRCDET(2)="RQD"_PRCCS_PRCCS_5
|
|
S PRCDET(2,"T")="QUANTITY"
|
|
S PRCDET(3)="RQ1"_PRCCS_PRCCS_4
|
|
S PRCDET(3,"T")="VENDOR ID"
|
|
S PRCDET(4)="RQ1"_PRCCS_PRCCS_1
|
|
S PRCDET(4,"T")="UNIT COST"
|
|
S PRCDET(5)="RQD"_PRCCS_PRCCS_10
|
|
S PRCDET(5,"T")="DATE NEEDED"
|
|
S PRCDET(6)="RQD"_PRCCS_PRCCS_2
|
|
S PRCDET(6,"T")="DYNAMED DOCUMENT ID"
|
|
S PRCDET(7)="RQ1"_PRCCS_PRCCS_5
|
|
S PRCDET(7,"T")="NIF NUMBER"
|
|
S PRCDET(8)="RQ1"_PRCCS_PRCCS_3
|
|
S PRCDET(8,"T")="BOC"
|
|
;Check if IFCAP has returned any errors
|
|
;
|
|
S ERRCNT=1
|
|
S PRCVERR(0)="0"
|
|
HEAD ;If there are errors in the "1" sub-segment, add all errors to all
|
|
; line items
|
|
S ERRCNT=1,MSGFLG=0,PRCSUB2=$P(PRCSUB,"*",2)
|
|
I $D(^XTMP(PRCSUB,1,"ERR"))>0 D
|
|
.S II=0
|
|
.F I=1:1 S II=$O(^XTMP(PRCSUB,1,"ERR",II)) Q:II="" D
|
|
..S ERRDAT=$G(^XTMP(PRCSUB,1,"ERR",II))
|
|
..Q:ERRDAT=""
|
|
..S MSGFLG=1
|
|
..S FLDNO=$P(ERRDAT,U,1),ERRCOD="PRCV"_$P(ERRDAT,U,2),ERRTXT=$P(ERRDAT,U,3)
|
|
..S SEVER=$P(ERRDAT,U,4)
|
|
..S ERRSTR="ERR"_PRCFS_PRCFS_PRCHD(FLDNO)_PRCFS_"207"_PRCCS_"Application internal error"_PRCCS_"HL70357"_PRCFS_SEVER_PRCFS_ERRCOD_PRCCS_ERRTXT_PRCFS
|
|
..S PRCVERR(ERRCNT)="Error in Requisition Header for "_PRCHD(FLDNO,"T")_" from HL7 MESSAGE "_PRCSUB2_" "_ERRCOD_" "_ERRTXT,ERRCNT=ERRCNT+1
|
|
..S J=0
|
|
..F IL=1:1 S J=$O(^XTMP(PRCSUB,2,J)) Q:J="" D
|
|
...S ERRSUB=$P(ERRSTR,PRCFS,3)
|
|
...S $P(ERRSUB,U,2)=J
|
|
...S $P(ERRSTR,PRCFS,3)=ERRSUB
|
|
...;S $P($P(ERRSTR,PRCFS,3),U,2)=J
|
|
...S $P(ERRSTR,PRCFS,7)=$P($G(^XTMP(PRCSUB,2,J)),U,6)
|
|
...S ^TMP("PRCVRIL",$J,"NAK",ACKCNT)=ERRSTR,ACKCNT=ACKCNT+1
|
|
DETAIL ;If there are errors in the detail lines, add them
|
|
S II=0
|
|
F I=1:1 S II=$O(^XTMP(PRCSUB,2,II)) Q:II="" D
|
|
.S DOCID=$P(^XTMP(PRCSUB,2,II),U,6)
|
|
.S III=0
|
|
.F J=1:1 S III=$O(^XTMP(PRCSUB,2,II,"ERR",III)) Q:III="" D
|
|
..S ERRDAT=$G(^XTMP(PRCSUB,2,II,"ERR",III))
|
|
..Q:ERRDAT=""
|
|
..S MSGFLG=1
|
|
..S FLDNO=$P(ERRDAT,U,1),ERRCOD="PRCV"_$P(ERRDAT,U,2),ERRTXT=$P(ERRDAT,U,3)
|
|
..S ERRLOC=PRCDET(FLDNO),$P(ERRLOC,U,2)=II
|
|
..S SEVER=$P(ERRDAT,U,4)
|
|
..S ERRSTR="ERR"_PRCFS_PRCFS_ERRLOC_PRCFS_"207"_PRCCS_"Application internal error"_PRCCS_"HL70357"_PRCFS_SEVER_PRCFS_ERRCOD_PRCCS_ERRTXT_PRCFS_DOCID
|
|
..S ^TMP("PRCVRIL",$J,"NAK",ACKCNT)=ERRSTR,ACKCNT=ACKCNT+1
|
|
..S PRCVERR(ERRCNT)="Error in detail for Message Control ID "_PRCSUB2_". Field in error - "_PRCDET(FLDNO,"T")_". "_ERRTXT_" DynaMed Doc ID "_DOCID
|
|
..S ERRCNT=ERRCNT+1
|
|
;
|
|
I MSGFLG=0 D ACKIT,CLEANUP^PRCVRE1 Q
|
|
SETNTE ; If there are errors set an NTE segment
|
|
;
|
|
S TOT=0,TOTREC=0,TOTERR=0
|
|
F I=1:1 S TOT=$O(^XTMP(PRCSUB,2,TOT)) Q:TOT="" D
|
|
.S TOTREC=TOT
|
|
.I $D(^XTMP(PRCSUB,2,TOT,"ERR"))>0 D
|
|
..S ERRS=0
|
|
..F J=1:1 S ERRS=$O(^XTMP(PRCSUB,2,TOT,"ERR",ERRS)) Q:ERRS="" D
|
|
...S SEVER=$P($G(^XTMP(PRCSUB,2,TOT,"ERR",ERRS)),U,4)
|
|
...I SEVER'="W" S TOTERR=TOTERR+1,ERRS=99
|
|
I $D(^XTMP(PRCSUB,2,"ERR",1))>1 S TOTERR=TOTREC
|
|
S TOTGOOD=TOTREC-TOTERR
|
|
S ^TMP("PRCVRIL",$J,"NAK",ACKCNT)="NTE"_PRCFS_PRCFS_PRCFS_TOTREC_"-"_TOTERR_"-"_TOTGOOD,ACKCNT=ACKCNT+1
|
|
D NAKIT,CLEANUP^PRCVRE1 Q
|
|
;
|
|
NAKIT ;Send an acknowledgement that the message is rejected
|
|
;
|
|
I HL("APAT")'="AL" Q
|
|
S MSG=""
|
|
F I=1:1 S MSG=$O(^TMP("PRCVRIL",$J,"NAK",MSG)) Q:MSG="" D
|
|
.S ^TMP("HLA",$J,I)=^TMP("PRCVRIL",$J,"NAK",MSG)
|
|
S PRCVRES=""
|
|
D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.PRCVRES)
|
|
;I +$P(PRCVRES,U,2) D
|
|
;.S PRCVERR(ERRCNT)="Application ACK not processed. Contact EVS."
|
|
MAIL ;Send MailMan message with error
|
|
Q:LENVAL="NOTOK"
|
|
N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
|
|
S XMSUB="RIL build errors in HL7 message "_HL("MID")_" "
|
|
S XMDUZ="IFCAP/DynaMed Interface"
|
|
S XMTEXT="PRCVERR("
|
|
D GETFCPU^PRCVLIC(.XMY,PRCSITE,PRCFCP)
|
|
D ^XMD
|
|
K XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
|
|
Q
|
|
;
|
|
ACKIT ;Send an acknowledgement that everything went fine
|
|
;
|
|
I HL("APAT")'="AL" Q
|
|
F I=1:1:1 S ^TMP("HLA",$J,I)=$G(^TMP("PRCVRIL",$J,"ACK",I))
|
|
;
|
|
D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.PRCVRES)
|
|
;I +P(PRCVRES,U,2) D
|
|
;.I $D(ERRCNT)=0 S ERRCNT=1
|
|
;.S PRCVERR(ERRCNT)="Application ACK not processed. Contact EVS."
|
|
;.D MAIL
|
|
Q
|