FBAALB.m

FBAALB ;AISC/GRR-LIST PAYMENT RECORDS FOR A BATCH ;01JAN86

 ;;3.5;FEE BASIS;;JAN 30, 1995

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

BT K FBAANQ W !! S DIC="^FBAA(161.7,",DIC(0)="AEQM" D ^DIC G Q:X="^"!(X=""),BT:Y<0 S B=+Y,Z=^FBAA(161.7,B,0),FBTYPE=$P(Z,"^",3)

 S VAR="FBTYPE^B",VAL=FBTYPE_"^"_B,PGM="START^FBAALB" D ZIS^FBAAUTL G:FBPOP Q S:IO=IO(0) FBAANQ=1

START S Q="",$P(Q,"=",80)="=",FBAAOUT=0 U IO W:$E(IOST,1,2)="C-" @IOF D ENM^FBAACCB:FBTYPE="B3",ENP^FBAACCB:FBTYPE="B5",ENT^FBAACCB0:FBTYPE="B2",PRTC^FBAACCB1:FBTYPE="B9"

 G:$D(FBAANQ) BT

Q D CLOSE^FBAAUTL K DIC,A,B,J,K,L,M,D,T,Y,Z,FBAANQ,FBAAOUT,FBTYPE,FBAC,FBAP,FBFD,FBPDT,FBSC,FBTD,A1,A2,CPTDESC,FBAACPT,FBIN,N,PGM,Q,S,V,VAL,VAR,VID,XY,ZS,FBVP,FBPV,DK,FBINTOT,FBINOLD,HDUZ,I,X,FBDX,FBI,FBK,FBL,FBPROC Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBAALB   799     printed  Apr 09, 2024@21:07:04                                                                                                                                                                                                       Page 2

FBAALB    ;AISC/GRR-LIST PAYMENT RECORDS FOR A BATCH ;01JAN86

 +1       ;;3.5;FEE BASIS;;JAN 30, 1995

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

BT         KILL FBAANQ

           WRITE !!

           SET DIC="^FBAA(161.7,"

           SET DIC(0)="AEQM"

           DO ^DIC

           if X="^"!(X="")

               GOTO Q

           if Y<0

               GOTO BT

           SET B=+Y

           SET Z=^FBAA(161.7,B,0)

           SET FBTYPE=$PIECE(Z,"^",3)

 +1        SET VAR="FBTYPE^B"

           SET VAL=FBTYPE_"^"_B

           SET PGM="START^FBAALB"

           DO ZIS^FBAAUTL

           if FBPOP

               GOTO Q

           if IO=IO(0)

               SET FBAANQ=1

START      SET Q=""

           SET $PIECE(Q,"=",80)="="

           SET FBAAOUT=0

           USE IO

           if $EXTRACT(IOST,1,2)="C-"

               WRITE @IOF

           if FBTYPE="B3"

               DO ENM^FBAACCB

           if FBTYPE="B5"

               DO ENP^FBAACCB

           if FBTYPE="B2"

               DO ENT^FBAACCB0

           if FBTYPE="B9"

               DO PRTC^FBAACCB1

 +1        if $DATA(FBAANQ)

               GOTO BT

Q          DO CLOSE^FBAAUTL

           KILL DIC,A,B,J,K,L,M,D,T,Y,Z,FBAANQ,FBAAOUT,FBTYPE,FBAC,FBAP,FBFD,FBPDT,FBSC,FBTD,A1,A2,CPTDESC,FBAACPT,FBIN,N,PGM,Q,S,V,VAL,VAR,VID,XY,ZS,FBVP,FBPV,DK,FBINTOT,FBINOLD,HDUZ,I,X,FBDX,FBI,FBK,FBL,FBPROC

           QUIT