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

FBAAVR5.m

Go to the documentation of this file.
  1. FBAAVR5 ;WOIFO/SAB - GENERATE VOUCHER BATCH MSG ;9/12/2012
  1. ;;3.5;FEE BASIS;**132,158**;JAN 30, 1995;Build 94
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; ICRs
  1. ; #2053 FILE^DIE
  1. ; #2054 CLEAN^DILF
  1. ; #2056 $$GET1^DIQ
  1. ; #2729 SENDMSG^XMXAPI
  1. ; #10104 $$LG^XLFSTR, $$RJ^XLFSTR
  1. Q
  1. ;
  1. VBMSG(FBN) ; Generate Voucher Batch Message
  1. ; input
  1. ; FBN - Batch IEN (file 161.7)
  1. ; returns value
  1. ; =message number if successful
  1. ; =0^error message if unsuccessful
  1. ;
  1. N FBAUS,FBCNT,FBHD,FBLN,FBNUM,FBRET,FBSTUB,FBTYPE
  1. K ^TMP($J,"FBVBM")
  1. ;
  1. ; check for required input
  1. I '$G(FBN) S FBRET="0^Batch IEN not provided." G END
  1. ;
  1. ; retrieve batch data
  1. S FBNUM=$$GET1^DIQ(161.7,FBN_",",.01) ; NUMBER
  1. I $D(DIERR) S FBRET="0^Error getting batch data." G END
  1. S FBTYPE=$$GET1^DIQ(161.7,FBN_",",2,"I") ; TYPE
  1. I "^B2^B3^B5^B9^"'[("^"_FBTYPE_"^") S FBRET="0^Invalid batch type" G END
  1. ;
  1. ; determine subsystem identifier
  1. D HD^FBAAUTL
  1. I $G(FBHD)="" S FBRET="0^Error obtaining Subsystem Identifier." G END
  1. ;
  1. ; determine string values to transmit
  1. S FBAUS("SN")=$$LJ^XLFSTR($$STANUM(FBN),6) ; station number
  1. S FBAUS("DT")=$$AUSDT^FBAAV3(DT) ; date
  1. S FBAUS("PT")=$S(FBTYPE="B2":"T",1:$E(FBTYPE,2)) ; payment type
  1. ;
  1. S FBCNT=0 ; init reject line count
  1. ;
  1. ; determine stub string for voucher batch reject line
  1. S FBSTUB=FBAUS("SN")_FBAUS("DT")_"V"_FBAUS("PT")
  1. ;
  1. ; loop thru line items rejected from batch
  1. I FBTYPE="B2" D
  1. . N FBIEN,FBIENS
  1. . S FBIEN(1)=0
  1. . F S FBIEN(1)=$O(^FBAAC("AG",FBN,FBIEN(1))) Q:'FBIEN(1) D
  1. . . S FBIEN=0
  1. . . F S FBIEN=$O(^FBAAC("AG",FBN,FBIEN(1),FBIEN)) Q:'FBIEN D
  1. . . . S FBIENS=FBIEN_","_FBIEN(1)_","
  1. . . . Q:$$GET1^DIQ(162.04,FBIENS,6.3,"I")=1 ; skip interface rej.
  1. . . . S FBPICN=FBIEN(1)_"^"_FBIEN
  1. . . . S FBPICN=$$ORGICN(162.04,FBPICN) ; send original ICN
  1. . . . D ADDLN
  1. ;
  1. I FBTYPE="B3" D
  1. . N FBIEN,FBIENS,FBPICN
  1. . S FBIEN(3)=0
  1. . F S FBIEN(3)=$O(^FBAAC("AH",FBN,FBIEN(3))) Q:'FBIEN(3) D
  1. . . S FBIEN(2)=0
  1. . . F S FBIEN(2)=$O(^FBAAC("AH",FBN,FBIEN(3),FBIEN(2))) Q:'FBIEN(2) D
  1. . . . S FBIEN(1)=0
  1. . . . F S FBIEN(1)=$O(^FBAAC("AH",FBN,FBIEN(3),FBIEN(2),FBIEN(1))) Q:'FBIEN(1) D
  1. . . . . S FBIEN=0
  1. . . . . F S FBIEN=$O(^FBAAC("AH",FBN,FBIEN(3),FBIEN(2),FBIEN(1),FBIEN)) Q:'FBIEN D
  1. . . . . . S FBIENS=FBIEN_","_FBIEN(1)_","_FBIEN(2)_","_FBIEN(3)_","
  1. . . . . . Q:$$GET1^DIQ(162.03,FBIENS,21.3,"I")=1 ; skip interface rej.
  1. . . . . . S FBPICN=FBIEN(3)_"^"_FBIEN(2)_"^"_FBIEN(1)_"^"_FBIEN
  1. . . . . . S FBPICN=$$ORGICN(162.03,FBPICN) ; send orignal ICN
  1. . . . . . D ADDLN
  1. ;
  1. I FBTYPE="B5" D
  1. . N FBIEN,FBIENS,FBPICN
  1. . S FBIEN(1)=0
  1. . F S FBIEN(1)=$O(^FBAA(162.1,"AF",FBN,FBIEN(1))) Q:'FBIEN(1) D
  1. . . S FBIEN=0
  1. . . F S FBIEN=$O(^FBAA(162.1,"AF",FBN,FBIEN(1),FBIEN)) Q:'FBIEN D
  1. . . . S FBIENS=FBIEN_","_FBIEN(1)_","
  1. . . . Q:$$GET1^DIQ(162.11,FBIENS,19.3,"I")=1 ; skip interface rej.
  1. . . . S FBPICN=FBIEN(1)_"^"_FBIEN
  1. . . . D ADDLN
  1. ;
  1. I FBTYPE="B9" D
  1. . N FBIEN,FBIENS,FBPICN
  1. . S FBIEN=0
  1. . F S FBIEN=$O(^FBAAI("AH",FBN,FBIEN)) Q:'FBIEN D
  1. . . S FBIENS=FBIEN_","
  1. . . Q:$$GET1^DIQ(162.5,FBIENS,15.3,"I")=1 ; skip interface rej.
  1. . . S FBPICN=FBIEN
  1. . . D ADDLN
  1. ;
  1. ; build message header line - FB*3.5*158
  1. S ^TMP($J,"FBVBM",1)=FBHD_"V"_FBAUS("PT")_FBAUS("DT")_FBAUS("SN")_$$RJ^XLFSTR(FBNUM,7,"0")_$$RJ^XLFSTR(FBCNT,3,"0")_"$"
  1. ;
  1. ; address and send message
  1. D
  1. . N FBINSTR,XMDUZ,XMERR,XMSUBJ,XMY,XMZ
  1. . S XMSUBJ="FEE BASIS VOUCHER MESSAGE BATCH "_FBNUM
  1. . S FBINSTR("ADDR FLAGS")="R"
  1. . D RECIP
  1. . D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,"^TMP("_$J_",""FBVBM"")",.XMY,.FBINSTR,.XMZ)
  1. . I $G(XMERR) S FBRET="0^Error generating mail message"
  1. . I '$G(XMERR) S FBRET=XMZ
  1. ;
  1. ; if message created update batch
  1. I FBRET D
  1. . N DIERR,FBFDA,FBX
  1. . S FBFDA(161.7,FBN_",",21)=DT ; VOUCHER MSG DATE
  1. . S FBFDA(161.7,FBN_",",22)="P" ; VOUCHER MSG ACK STATUS
  1. . D FILE^DIE("","FBFDA")
  1. . D CLEAN^DILF
  1. ;
  1. END ;
  1. K ^TMP($J,"FBVBM")
  1. Q FBRET
  1. ;
  1. ADDLN ; add detail line
  1. S FBCNT=FBCNT+1
  1. S ^TMP($J,"FBVBM",FBCNT+1)=FBSTUB_$$RJ^XLFSTR(FBPICN,30,"0")_"$"
  1. Q
  1. ;
  1. STANUM(FBN) ; determine station number to transmit
  1. ;
  1. N FBRET,FBX,FBY0
  1. S FBRET=""
  1. ;
  1. ; determine station number based on obligation of batch
  1. I $G(FBN) D
  1. . S FBY0=$G(^FBAA(161.7,FBN,0))
  1. . S FBX=$$SUB^FBAAUTL5(+$P(FBY0,U,8)_"-"_$P(FBY0,U,2))
  1. . I FBX]"" S FBRET=FBX
  1. ;
  1. ; if station number not found use default station number
  1. I FBRET="" D
  1. . S FBX=$P($G(^FBAA(161.4,1,1)),"^",3)
  1. . S:FBX FBRET=$$STA^XUAF4(FBX)
  1. ;
  1. Q FBRET
  1. ;
  1. RECIP ; determine message recipients
  1. ; input
  1. ; DUZ
  1. ; output
  1. ; XMDUZ
  1. ; XMY(
  1. N FBXMFEE,FBXMNVP
  1. S XMDUZ=DUZ
  1. ;
  1. ; get recipients from TRANSMISISON ROUTERS files
  1. D
  1. . N FBI,FBVAR,VAT,VATERR,VATNAME
  1. . D ADDRESS^FBAAV01
  1. ;
  1. ; set XMY array and XMDUZ
  1. D
  1. . N FBFLAG,FBI,XMD,XMLOC,XMMG,XMN,X,Y
  1. . D ROUT^FBAAV01
  1. Q
  1. ;
  1. ORGICN(FBFILE,FBICN) ; return original ICN value for a line item
  1. ; input
  1. ; FBFILE - sub-file (162.03 or 162.04)
  1. ; FBICN - ICN value
  1. ; return value = the original ICN value
  1. ;
  1. N FBRET
  1. S FBRET=$G(FBICN)
  1. ;
  1. I "^162.03^162.04^"[("^"_$G(FBFILE)_"^"),$G(FBICN)'="" D
  1. . N FBCIENS,FBOIENS,FBSIENS
  1. . ; determine starting IEN string
  1. . I FBFILE=162.03 S FBSIENS=$P(FBICN,"^",4)_","_$P(FBICN,"^",3)_","_$P(FBICN,"^",2)_","_$P(FBICN,"^",1)_","
  1. . I FBFILE=162.04 S FBSIENS=$P(FBICN,"^",2)_","_$P(FBICN,"^",1)_","
  1. . ;
  1. . S FBCIENS=FBSIENS ; init current IEN string as starting IEN string
  1. . ;
  1. . ;loop thru moves for current IENs until no more moves are found
  1. . F D Q:FBOIENS=""
  1. . . N FBDA
  1. . . S FBOIENS="" ; init old IENs value for a move
  1. . . S FBDA=$O(^FBAA(161.45,"AN",FBFILE,FBCIENS,0))
  1. . . Q:'FBDA ; no more moves
  1. . . S FBOIENS=$P($G(^FBAA(161.45,FBDA,0)),U,2) ; old IENs
  1. . . ; if old IEN is same as starting IEN, break out of the endless loop
  1. . . I FBOIENS=FBSIENS S FBOIENS="" Q
  1. . . ; set current IENs to the new value
  1. . . S:FBOIENS'="" FBCIENS=FBOIENS
  1. . ;
  1. . ; if current IENs is different from starting IENs update outputs
  1. . I FBCIENS'=FBSIENS D
  1. . . I FBFILE=162.03 S FBRET=$P(FBCIENS,",",4)_"^"_$P(FBCIENS,",",3)_"^"_$P(FBCIENS,",",2)_"^"_$P(FBCIENS,",",1)
  1. . . I FBFILE=162.04 S FBRET=$P(FBCIENS,",",2)_"^"_$P(FBCIENS,",",1)
  1. ;
  1. Q FBRET
  1. ;
  1. ;FBAAVR5