FBAASCB ;AISC/GRR - SUPERVISOR RELEASE ;5/15/14 15:48
;;3.5;FEE BASIS;**38,61,116,117,132,154**;JAN 30, 1995;Build 12
;;Per VA Directive 6402, this routine should not be modified.
S FBERR=0 D DT^DICRW
I '$D(^FBAA(161.7,"AC","C"))&('$D(^FBAA(161.7,"AC","A"))) W !!,*7,"There are no batches Pending Release!" Q
BT 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
D LOCK^FBUCUTL("^FBAA(161.7,",FBN) I 'FBLOCK W !!,*7,"Try releasing batch at another time." D Q G FBAASCB
S FZ=^FBAA(161.7,FBN,0),FBTYPE=$P(FZ,"^",3),FBAAON=$P(FZ,"^",2),FBAAB=$P(FZ,"^")
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
I $G(FBTYPE)="B9",$P(FZ,"^",15)="" S FBCNH=1
S FBSTAT=^FBAA(161.7,FBN,"ST"),FBSTAT=$S(FBSTAT="C":"S",FBSTAT="A":"R",1:FBSTAT)
S FBAAOB=$P(FZ,"^",8)_"-"_FBAAON,FBAAMT=$P(FZ,"^",9),FBCOMM="Release of batch "_FBAAB
; enforce segregation of duties (FB*3.5*117)
D UOKCERT^PRCEMOA(.FBUOK,FBAAOB,DUZ) ; IA #5573
I 'FBUOK D D Q G FBAASCB
. W $C(7),!,$P(FBUOK,U,2) ; display text returned by IFCAP API
. I $P(FBUOK,U)="0" W !,"Due to segregation of duties, you cannot also certify an invoice for payment."
. I $P(FBUOK,U)="E" W !,"This 1358 error must be resolved before the batch can be released."
;
S DA=FBN,DR="0:1;ST" W !! D EN^DIQ
RD 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"
RDD 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
D WAIT^DICD
S FBAARA=0
I FBTYPE="B9" D ^FBAASCB0 G SHORT:$D(FBERR)
I FBTYPE="B9",FBAARA>0 S FBAAMT=FBAARA D POST G SHORT:$D(FBERR)
I FBTYPE'="B9" D POST I $D(FBERR) G SHORT
FIN ;
; use FileMan to update fields 5 and 6, store date & time (FB*3.5*117)
S DA=FBN,DIE="^FBAA(161.7,"
S DR="11////^S X=FBSTAT;6////^S X=DUZ;5////^S X=$$NOW^XLFDT" D ^DIE
K DA,DIE,DIC,DR
D UCAUTOP
S DA=FBN,DR="0:1;ST",DIC="^FBAA(161.7," W !! D EN^DIQ W !!," Batch has been Released!"
D Q G FBAASCB
Q I $G(FBN) K ^XTMP("FBAASCB",FBN) L -^FBAA(161.7,FBN)
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
K FBAC,FBAP,FBCNH,FBFD,FBI,FBLISTC,FBPDT,FBSC,FBTD,PRCSCPAN,DFN,FBINV
K FBUOK,FBAARA
Q
SHORT ;
I '$D(FBINV) W !!,*7,"This batch CANNOT be released. Check your 1358.",!
L -^FBAA(161.7,FBN) D Q G FBAASCB
POST ;FBAAOB=FULL OBLIGATION NUMBER(STA-CXXXXX)
;FBCOMM=COMMENT FOR 1358
;FBAAMT=TOTAL AMOUNT OF BATCH
;FBAAB=BATCH NUMBER
;IF CALL FAILS FBERR RETURNED=1
;FBN added as 7th peice of 'X'. It is the interface ID
K FBERR
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
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
K PRCS("SITE"),PRCSI Q
UCAUTOP ; Unauthorized Claims Autoprint
; If unauthorized claims autoprint feature is enabled then check items
; in batch and print an unauthorized claim disposition letter if all
; payments for a claim have been released
; input FBN - batch ien
; FBTYPE - batch type
; FBCNH - (opt) equals 1 if batch is for community nursing home
N DA,FBDA,FBORDER,FBUC,FBUCA,FBX
Q:"^B3^B5^B9^"'[(U_FBTYPE_U) ; not an applicable batch type
Q:$G(FBCNH)=1 ; CNH batch won't have associated unauth claims
S FBUC=$$FBUC^FBUCUTL2(1)
Q:'$$PARAM^FBUCLET(FBUC) ; autoprint feature not enabled
;
; loop thru items in batch to build list of unauthorized claims
K ^TMP("FBUC",$J)
I FBTYPE="B3" D ; if outpatient/ancillary batch
. S DA(3)=0 F S DA(3)=$O(^FBAAC("AC",FBN,DA(3))) Q:'DA(3) D
. . S DA(2)=0 F S DA(2)=$O(^FBAAC("AC",FBN,DA(3),DA(2))) Q:'DA(2) D
. . . S DA(1)=0
. . . F S DA(1)=$O(^FBAAC("AC",FBN,DA(3),DA(2),DA(1))) Q:'DA(1) D
. . . . S DA=0
. . . . F S DA=$O(^FBAAC("AC",FBN,DA(3),DA(2),DA(1),DA)) Q:'DA D
. . . . . S FBX=$P($G(^FBAAC(DA(3),1,DA(2),1,DA(1),1,DA,0)),U,13)
. . . . . I FBX["FB583" S ^TMP("FBUC",$J,+FBX)=""
I FBTYPE="B5" D ; if pharmacy batch
. S DA(1)=0 F S DA(1)=$O(^FBAA(162.1,"AE",FBN,DA(1))) Q:'DA(1) D
. . S DA=0 F S DA=$O(^FBAA(162.1,"AE",FBN,DA(1),DA)) Q:'DA D
. . . S FBX=$P($G(^FBAA(162.1,DA(1),"RX",DA,2)),U,6)
. . . I FBX["FB583" S ^TMP("FBUC",$J,+FBX)=""
I FBTYPE="B9" D ; if inpatient batch
. S DA=0 F S DA=$O(^FBAAI("AC",FBN,DA)) Q:'DA D
. . S FBX=$P($G(^FBAAI(DA,0)),U,5)
. . I FBX["FB583" S ^TMP("FBUC",$J,+FBX)=""
;
; loop thru unauthorized claim list and print letter when appropriate
S FBDA=0 F S FBDA=$O(^TMP("FBUC",$J,FBDA)) Q:'FBDA D
. Q:'$$PAYST^FBUCUTL(FBDA) ; not all payments for claim released yet
. S FBUCA=$G(^FB583(FBDA,0))
. Q:$P(FBUCA,U,16)'=1 ; claim not flagged for printing
. S FBORDER=$$ORDER^FBUCUTL($P(FBUCA,U,24))
. D AUTO^FBUCLET(FBDA,FBORDER,FBUCA,FBUC) ; autoprint letter
;
K ^TMP("FBUC",$J)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAASCB 5526 printed Oct 16, 2024@17:57:26 Page 2
FBAASCB ;AISC/GRR - SUPERVISOR RELEASE ;5/15/14 15:48
+1 ;;3.5;FEE BASIS;**38,61,116,117,132,154**;JAN 30, 1995;Build 12
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 SET FBERR=0
DO DT^DICRW
+4 IF '$DATA(^FBAA(161.7,"AC","C"))&('$DATA(^FBAA(161.7,"AC","A")))
WRITE !!,*7,"There are no batches Pending Release!"
QUIT
BT WRITE !!
SET DIC="^FBAA(161.7,"
SET DIC(0)="AEQ"
SET DIC("S")="I ($G(^(""ST""))=""C""!($G(^(""ST""))=""A""))&('$G(^XTMP(""FBAASCB"",+Y)))"
DO ^DIC
KILL DIC("S")
if X="^"!(X="")
GOTO Q
if Y<0
GOTO BT
SET FBN=+Y
SET ^XTMP("FBAASCB",FBN)=1
+1 DO LOCK^FBUCUTL("^FBAA(161.7,",FBN)
IF 'FBLOCK
WRITE !!,*7,"Try releasing batch at another time."
DO Q
GOTO FBAASCB
+2 SET FZ=^FBAA(161.7,FBN,0)
SET FBTYPE=$PIECE(FZ,"^",3)
SET FBAAON=$PIECE(FZ,"^",2)
SET FBAAB=$PIECE(FZ,"^")
+3 IF $GET(FBTYPE)="B9"
IF $PIECE(FZ,"^",15)="Y"
IF $PIECE(^FBAA(161.7,FBN,"ST"),"^")="C"
IF $PIECE(FZ,"^",18)'="Y"
WRITE !!,*7,"Batch needs to be released to Pricer first.",!
GOTO Q
+4 IF $GET(FBTYPE)="B9"
IF $PIECE(FZ,"^",15)=""
SET FBCNH=1
+5 SET FBSTAT=^FBAA(161.7,FBN,"ST")
SET FBSTAT=$SELECT(FBSTAT="C":"S",FBSTAT="A":"R",1:FBSTAT)
+6 SET FBAAOB=$PIECE(FZ,"^",8)_"-"_FBAAON
SET FBAAMT=$PIECE(FZ,"^",9)
SET FBCOMM="Release of batch "_FBAAB
+7 ; enforce segregation of duties (FB*3.5*117)
+8 ; IA #5573
DO UOKCERT^PRCEMOA(.FBUOK,FBAAOB,DUZ)
+9 IF 'FBUOK
Begin DoDot:1
+10 ; display text returned by IFCAP API
WRITE $CHAR(7),!,$PIECE(FBUOK,U,2)
+11 IF $PIECE(FBUOK,U)="0"
WRITE !,"Due to segregation of duties, you cannot also certify an invoice for payment."
+12 IF $PIECE(FBUOK,U)="E"
WRITE !,"This 1358 error must be resolved before the batch can be released."
End DoDot:1
DO Q
GOTO FBAASCB
+13 ;
+14 SET DA=FBN
SET DR="0:1;ST"
WRITE !!
DO EN^DIQ
RD SET B=FBN
SET DIR(0)="Y"
SET DIR("A")="Want line items listed"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO Q
if Y
WRITE @IOF
if Y
if FBTYPE="B3"
DO LIST^FBAACCB
if FBTYPE="B5"
DO LISTP^FBAACCB
if FBTYPE="B2"
DO LISTT^FBAACCB0
if FBTYPE="B9"
DO LISTC^FBAACCB1
RDD SET DIR(0)="Y"
SET DIR("A")="Do you want to Release Batch as Correct"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO Q
IF 'Y
WRITE !!,"Batch has NOT been Released!",*7
DO Q
GOTO FBAASCB
+1 DO WAIT^DICD
+2 SET FBAARA=0
+3 IF FBTYPE="B9"
DO ^FBAASCB0
if $DATA(FBERR)
GOTO SHORT
+4 IF FBTYPE="B9"
IF FBAARA>0
SET FBAAMT=FBAARA
DO POST
if $DATA(FBERR)
GOTO SHORT
+5 IF FBTYPE'="B9"
DO POST
IF $DATA(FBERR)
GOTO SHORT
FIN ;
+1 ; use FileMan to update fields 5 and 6, store date & time (FB*3.5*117)
+2 SET DA=FBN
SET DIE="^FBAA(161.7,"
+3 SET DR="11////^S X=FBSTAT;6////^S X=DUZ;5////^S X=$$NOW^XLFDT"
DO ^DIE
+4 KILL DA,DIE,DIC,DR
+5 DO UCAUTOP
+6 SET DA=FBN
SET DR="0:1;ST"
SET DIC="^FBAA(161.7,"
WRITE !!
DO EN^DIQ
WRITE !!," Batch has been Released!"
+7 DO Q
GOTO FBAASCB
Q IF $GET(FBN)
KILL ^XTMP("FBAASCB",FBN)
LOCK -^FBAA(161.7,FBN)
+1 KILL 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
+2 KILL FBAC,FBAP,FBCNH,FBFD,FBI,FBLISTC,FBPDT,FBSC,FBTD,PRCSCPAN,DFN,FBINV
+3 KILL FBUOK,FBAARA
+4 QUIT
SHORT ;
+1 IF '$DATA(FBINV)
WRITE !!,*7,"This batch CANNOT be released. Check your 1358.",!
+2 LOCK -^FBAA(161.7,FBN)
DO Q
GOTO FBAASCB
POST ;FBAAOB=FULL OBLIGATION NUMBER(STA-CXXXXX)
+1 ;FBCOMM=COMMENT FOR 1358
+2 ;FBAAMT=TOTAL AMOUNT OF BATCH
+3 ;FBAAB=BATCH NUMBER
+4 ;IF CALL FAILS FBERR RETURNED=1
+5 ;FBN added as 7th peice of 'X'. It is the interface ID
+6 KILL FBERR
+7 SET PRCS("X")=FBAAOB
SET PRCS("TYPE")="FB"
DO EN3^PRCS58
IF Y=-1
WRITE !!,*7,?5,"1358 not available for posting!",!
SET FBERR=1
QUIT
+8 DO NOW^%DTC
SET X=FBAAOB_"^"_%_"^^"_FBAAMT_"^"_$SELECT($LENGTH(FBAAB)<3:$$PADZ^FBAAV01(FBAAB,4),1:FBAAB)_"^"_FBCOMM_"^"_FBN_"^"_1
SET PRCS("TYPE")="FB"
DO EN2^PRCS58
IF +Y=0
WRITE !!,*7,Y,!
SET FBERR=1
QUIT
+9 KILL PRCS("SITE"),PRCSI
QUIT
UCAUTOP ; Unauthorized Claims Autoprint
+1 ; If unauthorized claims autoprint feature is enabled then check items
+2 ; in batch and print an unauthorized claim disposition letter if all
+3 ; payments for a claim have been released
+4 ; input FBN - batch ien
+5 ; FBTYPE - batch type
+6 ; FBCNH - (opt) equals 1 if batch is for community nursing home
+7 NEW DA,FBDA,FBORDER,FBUC,FBUCA,FBX
+8 ; not an applicable batch type
if "^B3^B5^B9^"'[(U_FBTYPE_U)
QUIT
+9 ; CNH batch won't have associated unauth claims
if $GET(FBCNH)=1
QUIT
+10 SET FBUC=$$FBUC^FBUCUTL2(1)
+11 ; autoprint feature not enabled
if '$$PARAM^FBUCLET(FBUC)
QUIT
+12 ;
+13 ; loop thru items in batch to build list of unauthorized claims
+14 KILL ^TMP("FBUC",$JOB)
+15 ; if outpatient/ancillary batch
IF FBTYPE="B3"
Begin DoDot:1
+16 SET DA(3)=0
FOR
SET DA(3)=$ORDER(^FBAAC("AC",FBN,DA(3)))
if 'DA(3)
QUIT
Begin DoDot:2
+17 SET DA(2)=0
FOR
SET DA(2)=$ORDER(^FBAAC("AC",FBN,DA(3),DA(2)))
if 'DA(2)
QUIT
Begin DoDot:3
+18 SET DA(1)=0
+19 FOR
SET DA(1)=$ORDER(^FBAAC("AC",FBN,DA(3),DA(2),DA(1)))
if 'DA(1)
QUIT
Begin DoDot:4
+20 SET DA=0
+21 FOR
SET DA=$ORDER(^FBAAC("AC",FBN,DA(3),DA(2),DA(1),DA))
if 'DA
QUIT
Begin DoDot:5
+22 SET FBX=$PIECE($GET(^FBAAC(DA(3),1,DA(2),1,DA(1),1,DA,0)),U,13)
+23 IF FBX["FB583"
SET ^TMP("FBUC",$JOB,+FBX)=""
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+24 ; if pharmacy batch
IF FBTYPE="B5"
Begin DoDot:1
+25 SET DA(1)=0
FOR
SET DA(1)=$ORDER(^FBAA(162.1,"AE",FBN,DA(1)))
if 'DA(1)
QUIT
Begin DoDot:2
+26 SET DA=0
FOR
SET DA=$ORDER(^FBAA(162.1,"AE",FBN,DA(1),DA))
if 'DA
QUIT
Begin DoDot:3
+27 SET FBX=$PIECE($GET(^FBAA(162.1,DA(1),"RX",DA,2)),U,6)
+28 IF FBX["FB583"
SET ^TMP("FBUC",$JOB,+FBX)=""
End DoDot:3
End DoDot:2
End DoDot:1
+29 ; if inpatient batch
IF FBTYPE="B9"
Begin DoDot:1
+30 SET DA=0
FOR
SET DA=$ORDER(^FBAAI("AC",FBN,DA))
if 'DA
QUIT
Begin DoDot:2
+31 SET FBX=$PIECE($GET(^FBAAI(DA,0)),U,5)
+32 IF FBX["FB583"
SET ^TMP("FBUC",$JOB,+FBX)=""
End DoDot:2
End DoDot:1
+33 ;
+34 ; loop thru unauthorized claim list and print letter when appropriate
+35 SET FBDA=0
FOR
SET FBDA=$ORDER(^TMP("FBUC",$JOB,FBDA))
if 'FBDA
QUIT
Begin DoDot:1
+36 ; not all payments for claim released yet
if '$$PAYST^FBUCUTL(FBDA)
QUIT
+37 SET FBUCA=$GET(^FB583(FBDA,0))
+38 ; claim not flagged for printing
if $PIECE(FBUCA,U,16)'=1
QUIT
+39 SET FBORDER=$$ORDER^FBUCUTL($PIECE(FBUCA,U,24))
+40 ; autoprint letter
DO AUTO^FBUCLET(FBDA,FBORDER,FBUCA,FBUC)
End DoDot:1
+41 ;
+42 KILL ^TMP("FBUC",$JOB)
+43 QUIT
+44 ;
