source: FOIAVistA/trunk/r/FEE_BASIS-FB/FBCHC78.m@ 1733

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

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1FBCHC78 ;AISC/DMK-CANCEL A 7078 ;8/18/2004
2 ;;3.5;FEE BASIS;**82**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;check if user holds 'FBAASUPERVISOR' security key
5 Q:'$G(DUZ)
6 I '$D(^XUSEC("FBAASUPERVISOR",DUZ)) W !,"You must be a holder of the 'FBAASUPERVISOR' key to cancel a 7078.",! Q
7 ;
8 ;get station number from site parameter file
9 D SITEP^FBAAUTL G END:FBPOP
10 S FBPSA=$E($P($G(^DIC(4,+$P($G(FBSITE(1)),"^",3),99)),"^"),1,3)
11 ;
12ASK ;get 7078 entry to cancel
13 W ! S DIC(0)="AEQMZ",DIC="^FB7078(",D="D",DIC("A")="Select Patient: ",DIC("S")="I $P(^(0),U,9)'=""DC""&($P(^(0),U,11)=$S($D(FBNH):7,1:6))" D IX^DIC K DIC,D G END:X=""!(X="^"),ASK:Y<0
14 S FB7078=+Y_";FB7078(",FBAAOB=FBPSA_"-"_$P(Y(0,0),".")_"-"_$P(Y(0,0),".",2),DFN=+$P(Y(0),"^",3),FB(161)=+$O(^FBAAA("AG",FB7078,DFN,0)),FBMM=$E($P(Y(0),U,4),4,5)
15 S FBADDT=$P(Y(0),U,4),FBVEN=$P(Y(0),U,2)
16 I $D(FBNH) S DIC="^FBAACNH(",DIC(0)="MZ",DIC("S")="I $P(^(0),U,2)=DFN&($P(^(0),U,10)=FB(161))",X=$P(Y(0),U,4) D ^DIC K DIC I +Y>0 W !,*7,"Must delete all movements associated with this authorization before canceling.",! G END
17 ;
18 ;check if payments made against the 7078
19 ;if so do not allow a user to cancel
20 I $D(^FBAAI("E",FB7078)) W !!,*7,"There is already an invoice entered for this hospitalization. Cannot delete!",!! G END
21 I $D(^FBAAC("AM",FB7078)) W !!,*7,"There already are ancillary services entered against this authorization. Cannot delete!",!! G END
22 ;
23 ;display 7078 and ask if ok to cancel
24 S DA=+FB7078,DIC="^FB7078(",DR="0;1" D EN^DIQ
25 W ! S DIR(0)="Y",DIR("A")="Are you sure you want to cancel",DIR("B")="No" D ^DIR K DIR G FBCHC78:'Y,END:$D(DIRUT)
26 ;
27 ;cancelling 7078 and associated athorization in file 161
28 ;deleting associated 7078 from the notification file in civil hospital
29 ;remove entries assoiciated with CNH in 161.23
30 ;removing estimated amount from 1358
31 I '$D(FBNH) S DA=$O(^FBAA(162.2,"AM",+FB7078,0)) I DA S DIE="^FBAA(162.2,",DR="16///@" D ^DIE K DIC,DIE W " ."
32 S DA(1)=DFN,DA=$O(^FBAAA("AG",FB7078,DFN,0)) I DA S DIK="^FBAAA("_DFN_",1," D ^DIK K DIK,DA W "."
33 S DA=+FB7078,DIE="^FB7078(",DR=".013////^S X=DUZ;.014////^S X=DT;9////^S X=""DC""" D ^DIE K DIE,DIC W "."
34 I $D(FBNH) S FBI=0 F S FBI=$O(^FBAA(161.23,"AC",+FB7078,FBI)) Q:'FBI I $D(^FBAA(161.23,FBI,0)) D
35 . S DA=FBI,DIK="^FBAA(161.23," D ^DIK K DIK W "."
36 ; if cancelled civil hospital 7078 then delete associated PTF record
37 I '$G(FBNH) D PTFD^FBUTL6(DFN,FBADDT)
38 W !!,"Authorization cancelled. Now updating 1358.",!
39 D 1358 I $D(FBERR) W !,"Unable to affect 1358 adjustment. Use appropriate IFCAP options.",!
40 W "... Finished",!
41 ;
42END K DA,DR,DIE,DIC,DFN,FB,FBI,FB7078,FBAAOB,FBERR,PRC,PRCS,PRCSX,FBPSA,FBZZ,FBSITE,X,Y,FBPOP,FBNH,FBMM,FBADDT,FBVEN
43 Q
441358 ;subtract estimated dollar amount from 1358
45 ;FBAAOB=FULL OBLIGATION NUMBER (STATION #-OBLIGATION #-REF #)
46 ;FBERR returned if IFCAP call fails
47 ;internal entry # in 424 = $O(^PRC(424,"B",FBAAOB,0))
48 ;
49 ;check if 1358 available for posting
50 I '$$INTER() W !,*7,"Unable to locate reference number on 1358.",! S FBERR=1 Q
51 S PRCS("X")=$P(FBAAOB,"-",1,2),PRCS("TYPE")="FB" D EN3^PRCS58 I Y=-1 W !,*7,"1358 Not available for posting.",! S FBERR=1 Q
52 D NOW^%DTC
53 S PRCSX=$$INTER()_"^"_%_"^"_0_"^"_"Authorization has been cancelled"_"^"_1_"^"
54 S PRCS("TYPE")="FB" D ^PRCS58CC I Y'=1 W !,*7,$P(Y,"^",2),! S FBERR=1 Q
55 Q
56 ;
57INTER() ;get internal entry number from file 424
58 ;first check interface id x-ref
59 ;second check is to "B" x-ref to stay backward compatible with IFCAP3.6
60 ;
61 I '$G(FBNH),$D(^PRC(424,"E",DFN_";"_+FB7078_";"_$P(FBAAOB,"-",2))) Q $O(^(DFN_";"_+FB7078_";"_$P(FBAAOB,"-",2),0))
62 I $G(FBNH),$D(^PRC(424,"E",DFN_";"_+FB7078_";"_$P(FBAAOB,"-",2)_";"_FBMM)) Q $O(^(DFN_";"_+FB7078_";"_$P(FBAAOB,"-",2)_";"_FBMM,0))
63 I $D(^PRC(424,"B",FBAAOB)) Q $O(^(FBAAOB,0))
64 Q 0
65 ;
66CNH ;entry point to cancel an authorization associated with the
67 ;community nursing home program.
68 S FBNH=1 G FBCHC78
69 Q
Note: See TracBrowser for help on using the repository browser.