| [613] | 1 | FBMRASV2 ;AISC/TET - Server routine (Cont'd) ;8/29/97
|
|---|
| 2 | ;;3.5;FEE BASIS;**9**;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | EXIT S XMSER="S."_XQSOP,XMZ=XQMSG D REMSBMSG^XMA1C
|
|---|
| 5 | K I,XMER,XMRG,FBI,FBID,FBER,FBERR,FBSITE,FBPOP,FBSN,FBAASN,FBJ,FBRT,FBAC,FBSTN,FBVID,FBCHAIN,FBFEEO,FBVNAME,FBADD1,FBADD2,FBCITY,FBST,FBZIP,FBMRC,FBCC,FBPC,FBTID,FB1099,FBVT,FBICN,FBSC,FBPART,FBSTATE,FBICN1,K,DIE,DA,DR,X,DLAYGO
|
|---|
| 6 | K FBOGN,DIC,FBNGN,%X,%Y,DIK,FBTMP,FBMRA,FBCNT,FBATOT,FBCTOT,FBFTOT,FBQTOT,FBZIP1,FBCHK,FBOUT,XMSER,XMZ,^TMP("FBMRA",$J),^TMP("FBER",$J)
|
|---|
| 7 | Q
|
|---|
| 8 | EDIT ;edit check if fbac=q
|
|---|
| 9 | ;INPUT: FBAC = action code; should only come here if = 'Q'
|
|---|
| 10 | ; FBVID = vendor tax id number
|
|---|
| 11 | ; FBCHAIN = chain store (optional - only if pharmacy record type)
|
|---|
| 12 | ; FBICN = internal control number
|
|---|
| 13 | ; FBVNAME = vendor name from autsin transmission
|
|---|
| 14 | ;OUTPUT: FBAC may be changed from 'Q' to 'C' if id's have not changed,
|
|---|
| 15 | ; or if venid exists on file and austin name matches FBVNAME
|
|---|
| 16 | ; to avoid leaving duplicate vendors in site's vendor file.
|
|---|
| 17 | ;VAR: FBI = internal entry of vendor in vendor file with same id as FBVID
|
|---|
| 18 | ; FBVC = internal entry of vendor in vendor correction file (with station number stripped)
|
|---|
| 19 | N FBI,FBVCI S FBI=0,FBVCI=$E(FBICN,4,$L(FBICN))
|
|---|
| 20 | S:FBVID=$P($G(^FBAAV(+FBVCI,0)),U,2) FBAC="C" I FBAC="Q" S FBI=$O(^FBAAV("C",FBVID,0)) I FBI,FBVNAME=$P($G(^FBAAV(FBI,"AMS")),U) S FBAC="C"
|
|---|
| 21 | Q
|
|---|
| 22 | TRAP ;trap error, have bulletin message record error, send server message to group and reset trap to server error trap and exit.
|
|---|
| 23 | D @^%ZOSF("ERRTN")
|
|---|
| 24 | S XQSTXT(0)=""
|
|---|
| 25 | S XQSTXT(1)="*** Error detected by FEE while processing the above server message. ***"
|
|---|
| 26 | S XQSTXT(2)="Details recorded in the Kernel error trap."
|
|---|
| 27 | S XQSTXT(3)="Please contact your IRM representative immediately."
|
|---|
| 28 | S XQSTXT(4)="",XQSTXT(5)="The above message # has been forwarded to the FEE mail group."
|
|---|
| 29 | S XQSTXT(6)="Once the problem has been identified AND corrected, forward the server message"
|
|---|
| 30 | S XQSTXT(7)=$S($G(FBPAID):" to S.FBAA PAID SERVER",1:" to S.FBAA MRA SERVER")_" server to complete processing."
|
|---|
| 31 | ;S %ZTERLGR=$$LGR^%ZOSV D ^%ZTER
|
|---|
| 32 | ;S X="ERROR^XQSRV2",@^%ZOSF("TRAP")
|
|---|
| 33 | SEND K XMY S XMY("G.FEE")="" D ENT1^XMD ;send message to be processed
|
|---|
| 34 | D EXIT
|
|---|
| 35 | Q
|
|---|
| 36 | MSG ;set up server bulletin upon successful completion of processing
|
|---|
| 37 | S XQSTXT(0)="",XQSTXT(1)="Total Vendor MRA's Received: "_(FBATOT+FBCTOT+FBFTOT+FBQTOT)_" Processed: "_FBCNT_" Errors: "_FBER
|
|---|
| 38 | S XQSTXT(2)="ADDS: "_FBATOT,XQSTXT(3)="CHANGES: "_FBCTOT,XQSTXT(4)="UNSOLICITED ADDS: "_FBQTOT,XQSTXT(5)="FPDS-ONLY CHANGES: "_FBFTOT
|
|---|
| 39 | I +FBER S XQSTXT(6)="",XQSTXT(7)="*** "_FBER_" Error"_$S(FBER>1:"s",1:"")_" detected by FEE while processing the above server message. ***",XQSTXT(8)="" D
|
|---|
| 40 | .N EC,QCT
|
|---|
| 41 | .S QCT=8,EC="" F S EC=$O(^TMP("FBER",$J,EC)) Q:EC']"" D S QCT=QCT+1,XQSTXT(QCT)=""
|
|---|
| 42 | ..N I,DATA
|
|---|
| 43 | ..S QCT=QCT+1,XQSTXT(QCT)="ERROR CODE "_EC_": "
|
|---|
| 44 | ..I EC<4 S XQSTXT(QCT)=XQSTXT(QCT)_$S(EC=1:"Invalid Vendor ID",EC=2:"Invalid Record Length",EC=3:"Invalid Station Number",1:"")
|
|---|
| 45 | ..I EC'<4 S XQSTXT(QCT)=XQSTXT(QCT)_$S(EC=4:"Vendor names do not match",EC=4.1:"Vendor not found in file or vendor in delete status",EC=5:"Vendor change already processed",1:"")
|
|---|
| 46 | ..S XQSTXT(QCT)=" ===> "_XQSTXT(QCT)
|
|---|
| 47 | ..S QCT=QCT+1,XQSTXT(QCT)=" "_$S(EC<3:"Action necessary.",EC=3:"Action may be necessary.",1:"Information only.")_" Refer to the Vendor Error Code documentation."
|
|---|
| 48 | ..S QCT=QCT+1,XQSTXT(QCT)="",I=0 F S I=$O(^TMP("FBER",$J,EC,I)) Q:'I S DATA=^(I),QCT=QCT+1,XQSTXT(QCT)=DATA
|
|---|
| 49 | G EXIT
|
|---|
| 50 | ER(EC,J,FBER) ;set error & error count
|
|---|
| 51 | ;INPUT: EC = error code
|
|---|
| 52 | ; 1 = invalid vendor id (action needed)
|
|---|
| 53 | ; 2 = invalid record length (action needed)
|
|---|
| 54 | ; 3 = invalid station number (action may be necessary)
|
|---|
| 55 | ; 4 = vendor names do not match (ignore)
|
|---|
| 56 | ; 4.1 = vendor not found or in delete status (ignore)
|
|---|
| 57 | ; 5 = record already processed (ignore)
|
|---|
| 58 | ; J = data string from message/mra record
|
|---|
| 59 | ; FBER = error count
|
|---|
| 60 | ;OUTPUT: FBER updated
|
|---|
| 61 | I $S($G(FBER)']"":1,J']"":1,'+$G(EC):1,1:0) Q
|
|---|
| 62 | N FBCHAIN,FBRT,FBVID,FBVNAME
|
|---|
| 63 | I EC'=2 S FBRT=$E(J,1),FBVID=$S(FBRT=1:$E(J,9,19),1:$E(J,9,17)),FBVNAME=$S(FBRT=1:$E(J,27,56),1:$E(J,23,52)),FBCHAIN=$S(FBRT=1:"",1:" "_$E(J,18,21))
|
|---|
| 64 | S FBER=FBER+1,^TMP("FBER",$J,EC,FBER)=$S(EC=2:J,1:FBVNAME_" "_FBVID_FBCHAIN)
|
|---|
| 65 | Q
|
|---|
