source: FOIAVistA/trunk/r/FEE_BASIS-FB/FBMRASV2.m@ 811

Last change on this file since 811 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.3 KB
Line 
1FBMRASV2 ;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.
4EXIT 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
8EDIT ;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
22TRAP ;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")
33SEND K XMY S XMY("G.FEE")="" D ENT1^XMD ;send message to be processed
34 D EXIT
35 Q
36MSG ;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
50ER(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
Note: See TracBrowser for help on using the repository browser.