source: FOIAVistA/trunk/r/FEE_BASIS-FB/FBAASCB0.m@ 1354

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

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1FBAASCB0 ;AISC/DMK-POST 1358 FOR INPATIENT 7078'S ;03MAY91
2 ;;3.5;FEE BASIS;;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 K FBERR,^TMP($J) S FBRJC=0,FBINTOT=$P(FZ,U,10)
5 I '$O(^FBAAI("AC",FBN,0)) W !,*7,"No invoices found for this batch. Unable to release.",! S FBERR=1 Q
6 ;
7 S FBII=0 F S FBII=$O(^FBAAI("AC",FBN,FBII)) Q:'FBII!($D(FBERR)) S FBII78=$P($G(^FBAAI(FBII,0)),"^",5),FBAAMT=$P($G(^(0)),"^",9),FBMM=$E($P(^(0),U,6),4,5) D GET78:FBII78["FB7078(",POST^FBAASCB:FBII78["FB583("
8 I $G(FBRJC),FBRJC=FBINTOT S FBERR=1 D KILL Q
9 I $G(FBRJC) K FBERR S (FBRJC,FBII)=0 F S FBII=$O(^TMP($J,FBII)) Q:'FBII S X=$G(^FBAAI(FBII,0)),FBII78=$P(X,U,5),FBAAMT=$P(X,U,9),FBMM=$E($P(X,U,6),4,5) K X,^TMP($J,FBII) D GET78
10 I $G(FBRJC) S (FBAAMT,FBINTOT)=0 D NEWBT S FBII=0 F S FBII=$O(^TMP($J,FBII)) Q:'FBII D
11 .S DA=FBII,DIE="^FBAAI(",DR="20////^S X=FBBN" D ^DIE K DR,DA,DIE
12 .S FBAAMT=FBAAMT+$P(^FBAAI(FBII,0),U,9),FBINTOT=FBINTOT+1
13 D:$G(FBRJC) RESETBT
14 ;
15KILL K FBII,FBII78,FBAAMT,FBI78,FBMM,PRCSX,FBRJC,FBSTN,FBBN,FBINTOT,FBCNH,^TMP($J) Q
16 ;
17GET78 I '$D(^FB7078(+FBII78,0)) W !,*7,"No associated 7078 for invoice ",FBII,". Unable to release batch.",! S FBERR=1 Q
18 S FBI78=$P(^FB7078(+FBII78,0),"^"),DFN=+$P(^(0),"^",3),FBI78=$P(FZ,"^",8)_"-"_$P(FBI78,".")_"-"_$P(FBI78,".",2) D
19 . ;
20 . ;I $D(FBCNH),'$D(^PRC(424,"E",DFN_";"_+FBII78_";"_FBAAON_";"_FBMM)) D POST^FBAASCB
21 .D INPOST:$$INTER()
22 .I $D(FBCNH),'$$INTER S FBERR=1 W !!,$$NAME^FBCHREQ2(DFN)," ",$$SSN^FBAAUTL(DFN),!,*7,"Unable to locate reference number on 1358. Run Post Commitments for",!,"Obligation option."
23 .I $D(FBCNH),$D(FBERR) S ^TMP($J,+FBII)="",FBRJC=FBRJC+1 K FBERR
24 Q
25 ;
26INPOST ;PRCSX=INTERNAL DAILY REF #^INTERNAL DATE/TIME^AMT OF PAYMENT^COMMENTS^COMPLETE FLAG
27 ;FBI78=AUTHORIZATION NAME IN 424 (STA-CXXXXX-REF #)
28 ;FBERR RETURNED IF IFCAP CALL FAILS
29 ;FBCOMM=COMMENT
30 ;FBAAMT=ACTUAL AMOUNT OF PAYMENT
31 ;INTERFACE ID = DFN_";"_INTERNAL ENTRY NUMBER OF 7078_";"_FBAAON (OBLIGATION)_";" if CNH _FBMM (month of service)
32 ;INTERNAL DAILY REF # = $O(^PRC(424,"B","STA #-OBLIGATION #-REF #",0))
33 ;NEW INTERNAL DAILY REF # LOOKUP=$O(^PRC(424,"E",INTERFACE ID,0))
34 I '$$INTER() W !,*7,"Unable to locate reference number on 1358.",! S FBERR=1 Q
35 S PRCS("X")=FBAAOB,PRCS("TYPE")="FB" D EN3^PRCS58 I Y=-1 W !!,*7,"1358 not available for posting!",! S FBERR=1 Q
36 D NOW^%DTC
37 S PRCSX=$$INTER()_"^"_%_"^"_FBAAMT_"^"_$S($D(FBCOMM):FBCOMM,1:"")_"^"_1
38 D ^PRCS58CC I Y'=1 W !!,$$NAME^FBCHREQ2(DFN)," (",$$SSN^FBAAUTL(DFN,1),")",!,*7,$P(Y,"^",2),! S FBERR=1 Q
39 Q
40 ;
41INTER() ;get internal entry number from file 424
42 ;first check for new INTERFACE ID "E" x-ref in 424
43 ;2nd check is to "B" x-ref to stay backward compatible with IFCAP 3.6
44 ;
45 I '$D(FBCNH),$D(^PRC(424,"E",DFN_";"_+FBII78_";"_FBAAON)) Q $O(^(DFN_";"_+FBII78_";"_FBAAON,0))
46 I $D(FBCNH),$D(^PRC(424,"E",DFN_";"_+FBII78_";"_FBAAON_";"_FBMM)) Q $O(^(DFN_";"_+FBII78_";"_FBAAON_";"_FBMM,0))
47 I '$D(FBCNH),$D(^PRC(424,"B",FBI78)) Q $O(^(FBI78,0))
48 Q 0
49 ;
50NEWBT ;open new batch for cnh line items unable to post to 1358
51 S FBSTN=$P(FZ,U,8) W ! D GETNXB^FBAAUTL
52 S DIC="^FBAA(161.7,",DIC(0)="LQ",X=FBBN,DIC("DR")="1////^S X=FBAAON;2////^S X=""B9"";3////^S X=DT;4////^S X=$P(FZ,U,5);11////^S X=""O"";16////^S X=FBSTN",DLAYGO=161.7
53 K DD,DO D FILE^DICN S FBBN=+Y K DIC,DLAYGO
54 Q
55RESETBT ;reset original batch total $ set new batch totals
56 S X=$G(^FBAA(161.7,FBBN,0)),$P(X,U,9)=FBAAMT,$P(X,U,10)=FBINTOT,$P(X,U,11)=FBINTOT,^(0)=X K X
57 S $P(FZ,U,9)=$P(FZ,U,9)-FBAAMT,$P(FZ,U,10)=$P(FZ,U,10)-FBINTOT,$P(FZ,U,11)=$P(FZ,U,11)-FBINTOT,^FBAA(161.7,FBN,0)=FZ
58 W !!,*7,"A new batch, number ",$P(^FBAA(161.7,FBBN,0),U),", was opened for invoices unable to post to 1358.",!,"Adjust 1358 and take action on new batch.",!
59 Q
Note: See TracBrowser for help on using the repository browser.