Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FBMRASV2

FBMRASV2.m

Go to the documentation of this file.
  1. FBMRASV2 ;AISC/TET - Server routine (Cont'd) ;2/29/2012
  1. ;;3.5;FEE BASIS;**9,132**;JAN 30, 1995;Build 17
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. EXIT S XMSER="S."_XQSOP,XMZ=XQMSG D REMSBMSG^XMA1C
  1. 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
  1. 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)
  1. Q
  1. EDIT ;edit check if fbac=q
  1. ;INPUT: FBAC = action code; should only come here if = 'Q'
  1. ; FBVID = vendor tax id number
  1. ; FBCHAIN = chain store (optional - only if pharmacy record type)
  1. ; FBICN = internal control number
  1. ; FBVNAME = vendor name from autsin transmission
  1. ;OUTPUT: FBAC may be changed from 'Q' to 'C' if id's have not changed,
  1. ; or if venid exists on file and austin name matches FBVNAME
  1. ; to avoid leaving duplicate vendors in site's vendor file.
  1. ;VAR: FBI = internal entry of vendor in vendor file with same id as FBVID
  1. ; FBVC = internal entry of vendor in vendor correction file (with station number stripped)
  1. N FBI,FBVCI S FBI=0,FBVCI=$E(FBICN,4,$L(FBICN))
  1. 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"
  1. Q
  1. TRAP ;trap error, have bulletin message record error, send server message to group and reset trap to server error trap and exit.
  1. D @^%ZOSF("ERRTN")
  1. S XQSTXT(0)=""
  1. S XQSTXT(1)="*** Error detected by FEE while processing the above server message. ***"
  1. S XQSTXT(2)="Details recorded in the Kernel error trap."
  1. S XQSTXT(3)="Please contact your IRM representative immediately."
  1. S XQSTXT(4)="",XQSTXT(5)="The above message # has been forwarded to the FEE mail group."
  1. S XQSTXT(6)="Once the problem has been identified AND corrected, forward the server message"
  1. S XQSTXT(7)=" to S."_$G(XQSOP)_" server to complete processing."
  1. ;S %ZTERLGR=$$LGR^%ZOSV D ^%ZTER
  1. ;S X="ERROR^XQSRV2",@^%ZOSF("TRAP")
  1. ; generate FBAA SERVER bulletin for selected server options
  1. I "^FBAA BATCH SERVER^FBAA VOUCHER SERVER^FBAA REJECT SERVER^"[("^"_$G(XQSOP)_"^") D SNDBUL^FBSVBR("of Trapped Error")
  1. SEND ; send served message to G.FEE
  1. D
  1. . N XMDUZ,XMY,XMZ
  1. . S XMY("G.FEE")=""
  1. . S XMZ=XQMSG
  1. . D ENT1^XMD
  1. D EXIT
  1. Q
  1. MSG ;set up server bulletin upon successful completion of processing
  1. S XQSTXT(0)="",XQSTXT(1)="Total Vendor MRA's Received: "_(FBATOT+FBCTOT+FBFTOT+FBQTOT)_" Processed: "_FBCNT_" Errors: "_FBER
  1. S XQSTXT(2)="ADDS: "_FBATOT,XQSTXT(3)="CHANGES: "_FBCTOT,XQSTXT(4)="UNSOLICITED ADDS: "_FBQTOT,XQSTXT(5)="FPDS-ONLY CHANGES: "_FBFTOT
  1. 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
  1. .N EC,QCT
  1. .S QCT=8,EC="" F S EC=$O(^TMP("FBER",$J,EC)) Q:EC']"" D S QCT=QCT+1,XQSTXT(QCT)=""
  1. ..N I,DATA
  1. ..S QCT=QCT+1,XQSTXT(QCT)="ERROR CODE "_EC_": "
  1. ..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:"")
  1. ..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:"")
  1. ..S XQSTXT(QCT)=" ===> "_XQSTXT(QCT)
  1. ..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."
  1. ..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
  1. G EXIT
  1. ER(EC,J,FBER) ;set error & error count
  1. ;INPUT: EC = error code
  1. ; 1 = invalid vendor id (action needed)
  1. ; 2 = invalid record length (action needed)
  1. ; 3 = invalid station number (action may be necessary)
  1. ; 4 = vendor names do not match (ignore)
  1. ; 4.1 = vendor not found or in delete status (ignore)
  1. ; 5 = record already processed (ignore)
  1. ; J = data string from message/mra record
  1. ; FBER = error count
  1. ;OUTPUT: FBER updated
  1. I $S($G(FBER)']"":1,J']"":1,'+$G(EC):1,1:0) Q
  1. N FBCHAIN,FBRT,FBVID,FBVNAME
  1. 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))
  1. S FBER=FBER+1,^TMP("FBER",$J,EC,FBER)=$S(EC=2:J,1:FBVNAME_" "_FBVID_FBCHAIN)
  1. Q