source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBAASCB.m@ 846

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

initial load of WorldVistAEHR
File size: 5.1 KB
Line 
1FBAASCB ;AISC/GRR-SUPERVISOR RELEASE ;8/6/2003
2 ;;3.5;FEE BASIS;**38,61**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 S FBERR=0 D DT^DICRW
5 I '$D(^FBAA(161.7,"AC","C"))&('$D(^FBAA(161.7,"AC","A"))) W !!,*7,"There are no batches Pending Release!" Q
6BT W !! S DIC="^FBAA(161.7,",DIC(0)="AEQ",DIC("S")="I ($G(^(""ST""))=""C""!($G(^(""ST""))=""A""))&('$G(^XTMP(""FBAASCB"",+Y)))" D ^DIC K DIC("S") G Q:X="^"!(X=""),BT:Y<0 S FBN=+Y,^XTMP("FBAASCB",FBN)=1
7 D LOCK^FBUCUTL("^FBAA(161.7,",FBN) I 'FBLOCK W !!,*7,"Try releasing batch at another time." D Q G FBAASCB
8 S FZ=^FBAA(161.7,FBN,0),FBTYPE=$P(FZ,"^",3),FBAAON=$P(FZ,"^",2),FBAAB=$P(FZ,"^")
9 I $G(FBTYPE)="B9",$P(FZ,"^",15)="Y",$P(^FBAA(161.7,FBN,"ST"),"^")="C",$P(FZ,"^",18)'="Y" W !!,*7,"Batch needs to be released to Pricer first.",! G Q
10 I $G(FBTYPE)="B9",$P(FZ,"^",15)="" S FBCNH=1
11 S FBSTAT=^FBAA(161.7,FBN,"ST"),FBSTAT=$S(FBSTAT="C":"S",FBSTAT="A":"R",1:FBSTAT)
12 S FBAAOB=$P(FZ,"^",8)_"-"_FBAAON,FBAAMT=$P(FZ,"^",9),FBCOMM="Release of batch "_FBAAB
13 I '$D(^XUSEC("FBAASUPERVISOR",DUZ)) W !!,*7,"Sorry, only Supervisor can Release batch!" D Q G FBAASCB
14 S DA=FBN,DR="0;ST" W !! D EN^DIQ
15RD S B=FBN S DIR(0)="Y",DIR("A")="Want line items listed",DIR("B")="NO" D ^DIR K DIR G Q:$D(DIRUT) W:Y @IOF D:Y LIST^FBAACCB:FBTYPE="B3",LISTP^FBAACCB:FBTYPE="B5",LISTT^FBAACCB0:FBTYPE="B2",LISTC^FBAACCB1:FBTYPE="B9"
16RDD S DIR(0)="Y",DIR("A")="Do you want to Release Batch as Correct",DIR("B")="NO" D ^DIR K DIR G Q:$D(DIRUT) I 'Y W !!,"Batch has NOT been Released!",*7 D Q G FBAASCB
17 D WAIT^DICD I FBTYPE="B9" D ^FBAASCB0 G SHORT:$D(FBERR),FIN
18 D POST I $D(FBERR) G SHORT
19 G:FBTYPE="B5" FIN
20 G:FBTYPE="B9" FIN
21FIN S $P(FZ,"^",6)=DT,$P(FZ,"^",7)=DUZ,^FBAA(161.7,FBN,0)=FZ
22 S DA=FBN,(DIC,DIE)="^FBAA(161.7,",DIC(0)="LQ",DR="11////"_FBSTAT,DLAYGO=161.7 D ^DIE K DA,DIE,DIC,DR,DLAYGO
23 D UCAUTOP
24 ;S DA=FBN,DR="0;ST",DIC="^FBAA(161.7," W !! D EN^DIQ W !!," Batch has been Released!" D Q G FBAASCB
25 S DA=FBN,DR="0;ST",DIC="^FBAA(161.7," W !! D EN^DIQ W !!," Batch has been Released!"
26 ; process batch to queue 0.00 paid EDI invoices for FPPS, patch *61
27 D LOG^FBFHLL(FBN,FBTYPE)
28 D Q G FBAASCB
29Q I $G(FBN) K ^XTMP("FBAASCB",FBN) L -^FBAA(161.7,FBN)
30 K B,J,K,L,M,X,Y,Z,DIC,FBN,A,A1,A2,BE,CPTDESC,D0,DA,DL,DR,DRX,DX,FBAACB,FBAACPT,FBAAON,FBAAOUT,FBVP,FBIN,DK,N,XY,FBINOLD,FBINTOT,FBTYPE,FZ,P3,P4,Q,S,T,V,VID,ZS,FBAAB,FBAAMT,FBAAOB,FBCOMM,FBAUT,FBSITE,I,X,Y,Z,FBERR,DIRUT,FBSTAT,FBLOCK
31 K FBAC,FBAP,FBCNH,FBFD,FBI,FBLISTC,FBPDT,FBSC,FBTD,PRCSCPAN,DFN
32 Q
33SHORT W !!,*7,"This batch CANNOT be released. Check your 1358.",! L -^FBAA(161.7,FBN) D Q G FBAASCB
34POST ;FBAAOB=FULL OBLIGATION NUMBER(STA-CXXXXX)
35 ;FBCOMM=COMMENT FOR 1358
36 ;FBAAMT=TOTAL AMOUNT OF BATCH
37 ;FBAAB=BATCH NUMBER
38 ;IF CALL FAILS FBERR RETURNED=1
39 ;FBN added as 7th peice of 'X'. It is the interface ID
40 K FBERR
41 S PRCS("X")=FBAAOB,PRCS("TYPE")="FB" D EN3^PRCS58 I Y=-1 W !!,*7,?5,"1358 not available for posting!",! S FBERR=1 Q
42 D NOW^%DTC S X=FBAAOB_"^"_%_"^^"_FBAAMT_"^"_$S($L(FBAAB)<3:$$PADZ^FBAAV01(FBAAB,4),1:FBAAB)_"^"_FBCOMM_"^"_FBN_"^"_1,PRCS("TYPE")="FB" D EN2^PRCS58 I +Y=0 W !!,*7,Y,! S FBERR=1 Q
43 K PRCS("SITE"),PRCSI Q
44UCAUTOP ; Unauthorized Claims Autoprint
45 ; If unauthorized claims autoprint feature is enabled then check items
46 ; in batch and print an unauthorized claim disposition letter if all
47 ; payments for a claim have been released
48 ; input FBN - batch ien
49 ; FBTYPE - batch type
50 ; FBCNH - (opt) equals 1 if batch is for community nursing home
51 N DA,FBDA,FBORDER,FBUC,FBUCA,FBX
52 Q:"^B3^B5^B9^"'[(U_FBTYPE_U) ; not an applicable batch type
53 Q:$G(FBCNH)=1 ; CNH batch won't have associated unauth claims
54 S FBUC=$$FBUC^FBUCUTL2(1)
55 Q:'$$PARAM^FBUCLET(FBUC) ; autoprint feature not enabled
56 ;
57 ; loop thru items in batch to build list of unauthorized claims
58 K ^TMP("FBUC",$J)
59 I FBTYPE="B3" D ; if outpatient/ancillary batch
60 . S DA(3)=0 F S DA(3)=$O(^FBAAC("AC",FBN,DA(3))) Q:'DA(3) D
61 . . S DA(2)=0 F S DA(2)=$O(^FBAAC("AC",FBN,DA(3),DA(2))) Q:'DA(2) D
62 . . . S DA(1)=0
63 . . . F S DA(1)=$O(^FBAAC("AC",FBN,DA(3),DA(2),DA(1))) Q:'DA(1) D
64 . . . . S DA=0
65 . . . . F S DA=$O(^FBAAC("AC",FBN,DA(3),DA(2),DA(1),DA)) Q:'DA D
66 . . . . . S FBX=$P($G(^FBAAC(DA(3),1,DA(2),1,DA(1),1,DA,0)),U,13)
67 . . . . . I FBX["FB583" S ^TMP("FBUC",$J,+FBX)=""
68 I FBTYPE="B5" D ; if pharmacy batch
69 . S DA(1)=0 F S DA(1)=$O(^FBAA(162.1,"AE",FBN,DA(1))) Q:'DA(1) D
70 . . S DA=0 F S DA=$O(^FBAA(162.1,"AE",FBN,DA(1),DA)) Q:'DA D
71 . . . S FBX=$P($G(^FBAA(162.1,DA(1),"RX",DA,2)),U,6)
72 . . . I FBX["FB583" S ^TMP("FBUC",$J,+FBX)=""
73 I FBTYPE="B9" D ; if inpatient batch
74 . S DA=0 F S DA=$O(^FBAAI("AC",FBN,DA)) Q:'DA D
75 . . S FBX=$P($G(^FBAAI(DA,0)),U,5)
76 . . I FBX["FB583" S ^TMP("FBUC",$J,+FBX)=""
77 ;
78 ; loop thru unauthorized claim list and print letter when appropriate
79 S FBDA=0 F S FBDA=$O(^TMP("FBUC",$J,FBDA)) Q:'FBDA D
80 . Q:'$$PAYST^FBUCUTL(FBDA) ; not all payments for claim released yet
81 . S FBUCA=$G(^FB583(FBDA,0))
82 . Q:$P(FBUCA,U,16)'=1 ; claim not flagged for printing
83 . S FBORDER=$$ORDER^FBUCUTL($P(FBUCA,U,24))
84 . D AUTO^FBUCLET(FBDA,FBORDER,FBUCA,FBUC) ; autoprint letter
85 ;
86 K ^TMP("FBUC",$J)
87 Q
Note: See TracBrowser for help on using the repository browser.