FBCHC78 ;AISC/DMK - CANCEL A 7078 ;8/25/14 15:22
;;3.5;FEE BASIS;**82,154**;JAN 30, 1995;Build 12
;;Per VA Directive 6402, this routine should not be modified.
Q:'$G(DUZ)
;
;get station number from site parameter file
D SITEP^FBAAUTL G END:FBPOP
S FBPSA=$E($P($G(^DIC(4,+$P($G(FBSITE(1)),"^",3),99)),"^"),1,3)
;
ASK ;get 7078 entry to cancel
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
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)
S FBADDT=$P(Y(0),U,4),FBVEN=$P(Y(0),U,2)
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
;
;check if payments made against the 7078
;if so do not allow a user to cancel
I $D(^FBAAI("E",FB7078)) W !!,*7,"There is already an invoice entered for this hospitalization. Cannot delete!",!! G END
I $D(^FBAAC("AM",FB7078)) W !!,*7,"There already are ancillary services entered against this authorization. Cannot delete!",!! G END
;
;display 7078 and ask if ok to cancel
S DA=+FB7078,DIC="^FB7078(",DR="0;1" D EN^DIQ
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)
;
;cancelling 7078 and associated athorization in file 161
;deleting associated 7078 from the notification file in civil hospital
;remove entries assoiciated with CNH in 161.23
;removing estimated amount from 1358
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 " ."
S DA(1)=DFN,DA=$O(^FBAAA("AG",FB7078,DFN,0)) I DA S DIK="^FBAAA("_DFN_",1," D ^DIK K DIK,DA W "."
S DA=+FB7078,DIE="^FB7078(",DR=".013////^S X=DUZ;.014////^S X=DT;9////^S X=""DC""" D ^DIE K DIE,DIC W "."
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
. S DA=FBI,DIK="^FBAA(161.23," D ^DIK K DIK W "."
; if cancelled civil hospital 7078 then delete associated PTF record
I '$G(FBNH) D PTFD^FBUTL6(DFN,FBADDT)
W !!,"Authorization cancelled. Now updating 1358.",!
D 1358 I $D(FBERR) W !,"Unable to affect 1358 adjustment. Use appropriate IFCAP options.",!
W "... Finished",!
;
END K DA,DR,DIE,DIC,DFN,FB,FBI,FB7078,FBAAOB,FBERR,PRC,PRCS,PRCSX,FBPSA,FBZZ,FBSITE,X,Y,FBPOP,FBNH,FBMM,FBADDT,FBVEN
Q
1358 ;subtract estimated dollar amount from 1358
;FBAAOB=FULL OBLIGATION NUMBER (STATION #-OBLIGATION #-REF #)
;FBERR returned if IFCAP call fails
;internal entry # in 424 = $O(^PRC(424,"B",FBAAOB,0))
;
;check if 1358 available for posting
I '$$INTER() W !,*7,"Unable to locate reference number on 1358.",! S FBERR=1 Q
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
D NOW^%DTC
S PRCSX=$$INTER()_"^"_%_"^"_0_"^"_"Authorization has been cancelled"_"^"_1_"^"
S PRCS("TYPE")="FB" D ^PRCS58CC I Y'=1 W !,*7,$P(Y,"^",2),! S FBERR=1 Q
Q
;
INTER() ;get internal entry number from file 424
;first check interface id x-ref
;second check is to "B" x-ref to stay backward compatible with IFCAP3.6
;
I '$G(FBNH),$D(^PRC(424,"E",DFN_";"_+FB7078_";"_$P(FBAAOB,"-",2))) Q $O(^(DFN_";"_+FB7078_";"_$P(FBAAOB,"-",2),0))
I $G(FBNH),$D(^PRC(424,"E",DFN_";"_+FB7078_";"_$P(FBAAOB,"-",2)_";"_FBMM)) Q $O(^(DFN_";"_+FB7078_";"_$P(FBAAOB,"-",2)_";"_FBMM,0))
I $D(^PRC(424,"B",FBAAOB)) Q $O(^(FBAAOB,0))
Q 0
;
CNH ;entry point to cancel an authorization associated with the
;community nursing home program.
S FBNH=1 G FBCHC78
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBCHC78 3871 printed Apr 09, 2024@21:02:19 Page 2
FBCHC78 ;AISC/DMK - CANCEL A 7078 ;8/25/14 15:22
+1 ;;3.5;FEE BASIS;**82,154**;JAN 30, 1995;Build 12
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 if '$GET(DUZ)
QUIT
+4 ;
+5 ;get station number from site parameter file
+6 DO SITEP^FBAAUTL
if FBPOP
GOTO END
+7 SET FBPSA=$EXTRACT($PIECE($GET(^DIC(4,+$PIECE($GET(FBSITE(1)),"^",3),99)),"^"),1,3)
+8 ;
ASK ;get 7078 entry to cancel
+1 WRITE !
SET DIC(0)="AEQMZ"
SET DIC="^FB7078("
SET D="D"
SET DIC("A")="Select Patient: "
SET DIC("S")="I $P(^(0),U,9)'=""DC""&($P(^(0),U,11)=$S($D(FBNH):7,1:6))"
DO IX^DIC
KILL DIC,D
if X=""!(X="^")
GOTO END
if Y<0
GOTO ASK
+2 SET FB7078=+Y_";FB7078("
SET FBAAOB=FBPSA_"-"_$PIECE(Y(0,0),".")_"-"_$PIECE(Y(0,0),".",2)
SET DFN=+$PIECE(Y(0),"^",3)
SET FB(161)=+$ORDER(^FBAAA("AG",FB7078,DFN,0))
SET FBMM=$EXTRACT($PIECE(Y(0),U,4),4,5)
+3 SET FBADDT=$PIECE(Y(0),U,4)
SET FBVEN=$PIECE(Y(0),U,2)
+4 IF $DATA(FBNH)
SET DIC="^FBAACNH("
SET DIC(0)="MZ"
SET DIC("S")="I $P(^(0),U,2)=DFN&($P(^(0),U,10)=FB(161))"
SET X=$PIECE(Y(0),U,4)
DO ^DIC
KILL DIC
IF +Y>0
WRITE !,*7,"Must delete all movements associated with this authorization before canceling.",!
GOTO END
+5 ;
+6 ;check if payments made against the 7078
+7 ;if so do not allow a user to cancel
+8 IF $DATA(^FBAAI("E",FB7078))
WRITE !!,*7,"There is already an invoice entered for this hospitalization. Cannot delete!",!!
GOTO END
+9 IF $DATA(^FBAAC("AM",FB7078))
WRITE !!,*7,"There already are ancillary services entered against this authorization. Cannot delete!",!!
GOTO END
+10 ;
+11 ;display 7078 and ask if ok to cancel
+12 SET DA=+FB7078
SET DIC="^FB7078("
SET DR="0;1"
DO EN^DIQ
+13 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to cancel"
SET DIR("B")="No"
DO ^DIR
KILL DIR
if 'Y
GOTO FBCHC78
if $DATA(DIRUT)
GOTO END
+14 ;
+15 ;cancelling 7078 and associated athorization in file 161
+16 ;deleting associated 7078 from the notification file in civil hospital
+17 ;remove entries assoiciated with CNH in 161.23
+18 ;removing estimated amount from 1358
+19 IF '$DATA(FBNH)
SET DA=$ORDER(^FBAA(162.2,"AM",+FB7078,0))
IF DA
SET DIE="^FBAA(162.2,"
SET DR="16///@"
DO ^DIE
KILL DIC,DIE
WRITE " ."
+20 SET DA(1)=DFN
SET DA=$ORDER(^FBAAA("AG",FB7078,DFN,0))
IF DA
SET DIK="^FBAAA("_DFN_",1,"
DO ^DIK
KILL DIK,DA
WRITE "."
+21 SET DA=+FB7078
SET DIE="^FB7078("
SET DR=".013////^S X=DUZ;.014////^S X=DT;9////^S X=""DC"""
DO ^DIE
KILL DIE,DIC
WRITE "."
+22 IF $DATA(FBNH)
SET FBI=0
FOR
SET FBI=$ORDER(^FBAA(161.23,"AC",+FB7078,FBI))
if 'FBI
QUIT
IF $DATA(^FBAA(161.23,FBI,0))
Begin DoDot:1
+23 SET DA=FBI
SET DIK="^FBAA(161.23,"
DO ^DIK
KILL DIK
WRITE "."
End DoDot:1
+24 ; if cancelled civil hospital 7078 then delete associated PTF record
+25 IF '$GET(FBNH)
DO PTFD^FBUTL6(DFN,FBADDT)
+26 WRITE !!,"Authorization cancelled. Now updating 1358.",!
+27 DO 1358
IF $DATA(FBERR)
WRITE !,"Unable to affect 1358 adjustment. Use appropriate IFCAP options.",!
+28 WRITE "... Finished",!
+29 ;
END KILL DA,DR,DIE,DIC,DFN,FB,FBI,FB7078,FBAAOB,FBERR,PRC,PRCS,PRCSX,FBPSA,FBZZ,FBSITE,X,Y,FBPOP,FBNH,FBMM,FBADDT,FBVEN
+1 QUIT
1358 ;subtract estimated dollar amount from 1358
+1 ;FBAAOB=FULL OBLIGATION NUMBER (STATION #-OBLIGATION #-REF #)
+2 ;FBERR returned if IFCAP call fails
+3 ;internal entry # in 424 = $O(^PRC(424,"B",FBAAOB,0))
+4 ;
+5 ;check if 1358 available for posting
+6 IF '$$INTER()
WRITE !,*7,"Unable to locate reference number on 1358.",!
SET FBERR=1
QUIT
+7 SET PRCS("X")=$PIECE(FBAAOB,"-",1,2)
SET PRCS("TYPE")="FB"
DO EN3^PRCS58
IF Y=-1
WRITE !,*7,"1358 Not available for posting.",!
SET FBERR=1
QUIT
+8 DO NOW^%DTC
+9 SET PRCSX=$$INTER()_"^"_%_"^"_0_"^"_"Authorization has been cancelled"_"^"_1_"^"
+10 SET PRCS("TYPE")="FB"
DO ^PRCS58CC
IF Y'=1
WRITE !,*7,$PIECE(Y,"^",2),!
SET FBERR=1
QUIT
+11 QUIT
+12 ;
INTER() ;get internal entry number from file 424
+1 ;first check interface id x-ref
+2 ;second check is to "B" x-ref to stay backward compatible with IFCAP3.6
+3 ;
+4 IF '$GET(FBNH)
IF $DATA(^PRC(424,"E",DFN_";"_+FB7078_";"_$PIECE(FBAAOB,"-",2)))
QUIT $ORDER(^(DFN_";"_+FB7078_";"_$PIECE(FBAAOB,"-",2),0))
+5 IF $GET(FBNH)
IF $DATA(^PRC(424,"E",DFN_";"_+FB7078_";"_$PIECE(FBAAOB,"-",2)_";"_FBMM))
QUIT $ORDER(^(DFN_";"_+FB7078_";"_$PIECE(FBAAOB,"-",2)_";"_FBMM,0))
+6 IF $DATA(^PRC(424,"B",FBAAOB))
QUIT $ORDER(^(FBAAOB,0))
+7 QUIT 0
+8 ;
CNH ;entry point to cancel an authorization associated with the
+1 ;community nursing home program.
+2 SET FBNH=1
GOTO FBCHC78
+3 QUIT
