FBCHSCB.m

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 ---FBCHSCB   1514     printed  Apr 09, 2024@21:01:17                                                                                                                                                                                                     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