- 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 ---[H[J[2J[HFBAALB 799 printed Feb 18, 2025@23:22:09 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