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

FBSVVA.m

Go to the documentation of this file. 
  1. FBSVVA ;ISW/SAB - VOUCHER BATCH ACKNOWLEDGEMENT MESSAGE SERVER ;4/23/2012
  1.  ;;3.5;FEE BASIS;**131,132,158**;JAN 30, 1995;Build 94
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; This routine is called by a server option to process the
  1.  ; Payment Batch Result message sent by Central Fee.
  1.  ;
  1.  ; ICRs
  1.  ;  #2053  FILE^DIE
  1.  ;  #2054  CLEAN^DILF
  1.  ;  #2056  $$GET1^DIQ
  1.  ;  #10069 XMB
  1.  ;  #10072 REMSBMSG^XMA1C
  1.  ;  #10096 ^%ZOSF("ERRTN" ), ^%ZOSF("TRAP")
  1.  ;  #10103 $$FMTE^XLFDT, $$NOW^XLFDT
  1.  ;  #10104 $$TRIM^XLFSTR
  1.  ;
  1.  ; init
  1.  N FBERR,FBHDR,FBHL,FBN,FBSN,FBSTAT,FBTYPE,X,XMER,XMRG,FBNEW
  1.  S FBERR=0
  1.  ;
  1.  ; switch to a Fee Basis server error trap
  1.  S X="TRAP^FBMRASV2" S @^%ZOSF("TRAP")
  1.  ;
  1. HDR ; process header line
  1.  X XMREC
  1.  I XMER<0 D ERR("Error reading header line.")
  1.  I FBERR G END
  1.  I $E(XMRG,2,4)="FEV" G HDR ; skip initial line if just envelope data
  1.  ;
  1.  I $L(XMRG)'=25,$L(XMRG)'=26 D ERR("Header line has incorrect length.")  ;FB*3.5*158
  1.  I FBERR G END
  1.  ;
  1.  ; extract data from header line
  1.  S FBHL(1)=$$TRIM^XLFSTR($E(XMRG,1,6),"R") ; station number
  1.  S FBHL(2)=$E(XMRG,7,14) ; date YYYYMMDD
  1.  S FBHL(3)=$E(XMRG,15) ; processing stage (A)
  1.  S FBHL(4)=$E(XMRG,16) ; payment type (3, 5, 9, or T)
  1.  ;FB*3.5*158
  1.  S FBNEW=$S($L(XMRG)=25:0,1:1)
  1.  ;
  1.  I FBNEW D
  1.  . S FBHL(5)=+$E(XMRG,17,23) ; batch number
  1.  . S FBHL(6)=$E(XMRG,24,25) ; status (AA or AE)
  1.  . S FBHL(7)=$E(XMRG,26) ; delimiter ($)
  1.  E  D
  1.  . S FBHL(5)=+$E(XMRG,17,22) ; batch number
  1.  . S FBHL(6)=$E(XMRG,23,24) ; status (AA or AE)
  1.  . S FBHL(7)=$E(XMRG,25) ; delimiter ($)
  1.  ;
  1.  ; validate header data
  1.  I FBHL(3)'="A" D ERR("Processing stage ("_FBHL(3)_") is invalid.")
  1.  I "^3^5^9^T^"'[("^"_FBHL(4)_"^") D ERR("Payment type ("_FBHL(4)_") is invalid.")
  1.  I "^AA^AE^"'[("^"_FBHL(6)_"^") D ERR("Acknowledgement status ("_FBHL(6)_") is invalid.")
  1.  I FBERR G END
  1.  ;
  1.  ; determine batch IEN
  1.  S FBN=$O(^FBAA(161.7,"B",FBHL(5),0))
  1.  I 'FBN D ERR("Could not locate record for batch "_FBHL(5)_".")
  1.  I FBERR G END
  1.  ;
  1.  ; obtain batch data
  1.  S FBTYPE=$$GET1^DIQ(161.7,FBN_",",2,"I") ; type (internal)
  1.  S FBSTAT=$$GET1^DIQ(161.7,FBN_",",11,"I") ; status (internal)
  1.  S FBSN=$$GET1^DIQ(161.7,FBN_",",16) ; station number (3 digit)
  1.  ;
  1.  ; verify batch values
  1.  I FBHL(4)="T",FBTYPE'="B2" D ERR("Payment Type in message is not consistent with the batch type.")
  1.  I FBHL(4),FBHL(4)'=$E(FBTYPE,2) D ERR("Payment Type in message is not consistent with the batch type.")
  1.  I FBSN'=$E(FBHL(1),1,3) D ERR("Station number in message is not consistent with the batch station number.")
  1.  I FBSTAT'="V" D ERR("Current batch status is not VOUCHERED.")
  1.  I FBERR G END
  1.  ;
  1.  ; loop thru detail lines (errors and warnings) in message
  1.  S FBHDR=1
  1.  F  X XMREC Q:XMER<0!($E(XMRG,1,4)="NNNN")  I XMRG]"" D
  1.  . N FBDL
  1.  . ;
  1.  . S FBDL(6)=$E(XMRG,$S(FBNEW:24,1:23),$S(FBNEW:24,1:23)) ; severity (E or W)
  1.  . S FBDL(7)=$$TRIM^XLFSTR($E(XMRG,$S(FBNEW:25,1:24),$S(FBNEW:28,1:27))) ; message code
  1.  . S FBDL(8)=$$TRIM^XLFSTR($E(XMRG,$S(FBNEW:29,1:28),$S(FBNEW:98,1:97))) ; message text
  1.  . ;
  1.  . I FBHDR D MSG("Messages from Central Fee follow") S FBHDR=0
  1.  . D MSG(" ("_FBDL(6)_")  "_FBDL(8))
  1.  ;
  1.  ; update batch
  1.  I FBN D
  1.  . N DIERR,FBFDA,FBX
  1.  . ; set VOUCHER MSG ACK STATUS to A or E
  1.  . S FBFDA(161.7,FBN_",",22)=$S(FBHL(6)="AA":"A",1:"E")
  1.  . D FILE^DIE("","FBFDA")
  1.  . D CLEAN^DILF
  1.  ;
  1. END ;
  1.  ; switch back to the standard Kernel error trap
  1.  S X=^%ZOSF("ERRTN"),@^%ZOSF("TRAP")
  1.  ;
  1.  ; remove Central Fee message from server basket
  1.  N XMSER,XMZ
  1.  S XMSER="S."_XQSOP,XMZ=XQMSG D REMSBMSG^XMA1C
  1.  ;
  1.  I FBERR D
  1.  . ; add text to bulletin
  1.  . D ERR(" ")
  1.  . D ERR("The above message # has been forwarded to the FEE mail group.")
  1.  . ;
  1.  . ; send bulletin
  1.  . D SNDBUL^FBSVBR("for batch "_$G(FBHL(5))_" voucher ack.")
  1.  . ;
  1.  . ; forward served message to G.FEE
  1.  . N XMDUZ,XMY,XMZ
  1.  . S XMY("G.FEE")=""
  1.  . S XMZ=XQMSG
  1.  . D ENT1^XMD
  1.  ;
  1.  ; if no VistA error, but Central Fee sent a warning or error
  1.  I 'FBERR,'FBHDR D
  1.  . ; send bulletin
  1.  . D SNDBUL^FBSVBR("for batch "_$G(FBHL(5))_" voucher ack.")
  1.  ;
  1.  K XQSTXT
  1.  Q
  1.  ;
  1. ERR(FBTXT) ; set error flag and save text for inclusion in bulletin
  1.  N FBL
  1.  S FBERR=1
  1.  S FBL=$P($G(XQSTXT(0)),"^",4)
  1.  S FBL=FBL+1
  1.  S XQSTXT(FBL)=$G(FBTXT)
  1.  S $P(XQSTXT(0),"^",3,4)=FBL_"^"_FBL
  1.  Q
  1.  ;
  1. MSG(FBTXT) ; set save text for inclusion in bulletin
  1.  N FBL
  1.  S FBL=$P($G(XQSTXT(0)),"^",4)
  1.  S FBL=FBL+1
  1.  S XQSTXT(FBL)=$G(FBTXT)
  1.  S $P(XQSTXT(0),"^",3,4)=FBL_"^"_FBL
  1.  Q
  1.  ;
  1.  ;FBSVVA