FBCHSCB ;AISC/GRR - SUPERVISOR RELEASE ;11/2/2010
;;3.5;FEE BASIS;**117**;JAN 30, 1995;Build 9
;;Per VHA Directive 2004-038, this routine should not be modified.
D DT^DICRW
I '$D(^FBAA(161.7,"AC","C")) W !!,*7,"There are no batches Pending Release!" Q
BT W !! S DIC="^FBAA(161.7,",DIC(0)="AEQZ",DIC("S")="I $P(^(0),U,15)=""Y"",$G(^(""ST""))=""C""" D ^DIC K DIC("S") G Q:X="^"!(X=""),BT:Y<0 S FBN=+Y,FZ=Y(0),FBTYPE=$P(FZ,"^",3),FBAAON=$P(FZ,"^",2),FBAAB=$P(FZ,"^")
I $P(FZ,"^",18)["Y" W !!,*7,"This Batch is exempt from the Pricer!!!",!,"Please use the 'Release a Batch' option to forward this batch for payment." G Q
S DA=FBN,DR="0;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 BT:$D(DIRUT) D:Y LISTC
RDD S DIR(0)="Y",DIR("A")="Do you want to Release Batch as Correct",DIR("B")="NO" D ^DIR K DIR G BT:$D(DIRUT) I 'Y W !!,"Batch has NOT been Released!",*7 G BT
; use FileMan to update fields 5 and 6 (PRC*3.5*117)
S DA=FBN,DIE="^FBAA(161.7,",DR="11////^S X=""S"";6////^S X=DUZ;5////^S X=DT" D ^DIE
S DA=FBN,DR="0;ST",DIC="^FBAA(161.7," W !! D EN^DIQ W !!," Batch has been Released!" G BT
Q 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,DUOUT,DTOUT
K FBK,FBL,FBPDT,FBTD,DIE
K DLAYGO,FBLISTC D END^FBCHDI Q
;
LISTC D HOME^%ZIS W @IOF
D LISTC^FBAACCB1 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBCHSCB 1514 printed Nov 22, 2024@17:08:09 Page 2
FBCHSCB ;AISC/GRR - SUPERVISOR RELEASE ;11/2/2010
+1 ;;3.5;FEE BASIS;**117**;JAN 30, 1995;Build 9
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 DO DT^DICRW
+4 IF '$DATA(^FBAA(161.7,"AC","C"))
WRITE !!,*7,"There are no batches Pending Release!"
QUIT
BT WRITE !!
SET DIC="^FBAA(161.7,"
SET DIC(0)="AEQZ"
SET DIC("S")="I $P(^(0),U,15)=""Y"",$G(^(""ST""))=""C"""
DO ^DIC
KILL DIC("S")
if X="^"!(X="")
GOTO Q
if Y<0
GOTO BT
SET FBN=+Y
SET FZ=Y(0)
SET FBTYPE=$PIECE(FZ,"^",3)
SET FBAAON=$PIECE(FZ,"^",2)
SET FBAAB=$PIECE(FZ,"^")
+1 IF $PIECE(FZ,"^",18)["Y"
WRITE !!,*7,"This Batch is exempt from the Pricer!!!",!,"Please use the 'Release a Batch' option to forward this batch for payment."
GOTO Q
+2 SET DA=FBN
SET DR="0;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 BT
if Y
DO LISTC
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 BT
IF 'Y
WRITE !!,"Batch has NOT been Released!",*7
GOTO BT
+1 ; use FileMan to update fields 5 and 6 (PRC*3.5*117)
+2 SET DA=FBN
SET DIE="^FBAA(161.7,"
SET DR="11////^S X=""S"";6////^S X=DUZ;5////^S X=DT"
DO ^DIE
+3 SET DA=FBN
SET DR="0;ST"
SET DIC="^FBAA(161.7,"
WRITE !!
DO EN^DIQ
WRITE !!," Batch has been Released!"
GOTO BT
Q 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,DUOUT,DTOUT
+1 KILL FBK,FBL,FBPDT,FBTD,DIE
+2 KILL DLAYGO,FBLISTC
DO END^FBCHDI
QUIT
+3 ;
LISTC DO HOME^%ZIS
WRITE @IOF
+1 DO LISTC^FBAACCB1
QUIT
