FBAADOB.m

FBAADOB ;AISC/GRR-DISPLAY OPEN BATCHES ;03JAN86

 ;;3.5;FEE BASIS;**158**;JAN 30, 1995;Build 94

 ;;Per VA Directive 6402, this routine should not be modified.

 S IOP=$S($D(ION):ION,1:"HOME") D ^%ZIS K IOP S Q="",$P(Q,"=",80)="=",FBAAOUT=0

 I '$D(^FBAA(161.7,"AC","O")) W !!,*7,"There are No Open Batches!",!! G Q

 D HED

 F B=0:0 S B=$O(^FBAA(161.7,"AC","O",B)) Q:B'>0!(FBAAOUT)  I $D(^FBAA(161.7,B,0)) S Z=^(0) D WRT

Q K A,B1,B2,B3,B4,B5,Q,Z,B,BT,D,FBAAOUT,J,K,POP,X,Y Q

HED W @IOF W !,"Batch #","  Type",?22,"Dt Open",?32,"Clerk Who Opened",?65,"Obligation #",!,Q

 Q

WRT I $Y+5>IOSL S DIR(0)="E" D ^DIR K DIR S:'Y FBAAOUT=1 Q:FBAAOUT  W @IOF D HED

 S B1=$P(Z,"^",1),B4=$P(Z,"^",2),B2=$$DATX^FBAAUTL($P(Z,"^",4)),BT=$P(Z,"^",3)

 S BT=$S(BT="B3":"Medical",BT="B5":"Pharmacy",BT="B2":"Travel",BT="B9":"CH/CNH",1:"Unknown")

 S BT=$S($P($G(Z),U,19):BT_"-STAT",1:BT)

 S B3=$S($P(Z,"^",5)]"":$P(Z,"^",5),1:""),B3=$S(B3="":"",$D(^VA(200,B3,0)):$P(^VA(200,B3,0),"^",1),1:"")

 W !!,B1,?9,BT,?22,B2,?32,B3,?65,B4  ;FB*3.5*158

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBAADOB   1035     printed  Apr 09, 2024@21:03:41                                                                                                                                                                                                     Page 2

FBAADOB   ;AISC/GRR-DISPLAY OPEN BATCHES ;03JAN86

 +1       ;;3.5;FEE BASIS;**158**;JAN 30, 1995;Build 94

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3        SET IOP=$SELECT($DATA(ION):ION,1:"HOME")

           DO ^%ZIS

           KILL IOP

           SET Q=""

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

           SET FBAAOUT=0

 +4        IF '$DATA(^FBAA(161.7,"AC","O"))

               WRITE !!,*7,"There are No Open Batches!",!!

               GOTO Q

 +5        DO HED

 +6        FOR B=0:0

               SET B=$ORDER(^FBAA(161.7,"AC","O",B))

               if B'>0!(FBAAOUT)

                   QUIT 

               IF $DATA(^FBAA(161.7,B,0))

                   SET Z=^(0)

                   DO WRT

Q          KILL A,B1,B2,B3,B4,B5,Q,Z,B,BT,D,FBAAOUT,J,K,POP,X,Y

           QUIT 

HED        WRITE @IOF

           WRITE !,"Batch #","  Type",?22,"Dt Open",?32,"Clerk Who Opened",?65,"Obligation #",!,Q

 +1        QUIT 

WRT        IF $Y+5>IOSL

               SET DIR(0)="E"

               DO ^DIR

               KILL DIR

               if 'Y

                   SET FBAAOUT=1

               if FBAAOUT

                   QUIT 

               WRITE @IOF

               DO HED

 +1        SET B1=$PIECE(Z,"^",1)

           SET B4=$PIECE(Z,"^",2)

           SET B2=$$DATX^FBAAUTL($PIECE(Z,"^",4))

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

 +2        SET BT=$SELECT(BT="B3":"Medical",BT="B5":"Pharmacy",BT="B2":"Travel",BT="B9":"CH/CNH",1:"Unknown")

 +3        SET BT=$SELECT($PIECE($GET(Z),U,19):BT_"-STAT",1:BT)

 +4        SET B3=$SELECT($PIECE(Z,"^",5)]"":$PIECE(Z,"^",5),1:"")

           SET B3=$SELECT(B3="":"",$DATA(^VA(200,B3,0)):$PIECE(^VA(200,B3,0),"^",1),1:"")

 +5       ;FB*3.5*158

           WRITE !!,B1,?9,BT,?22,B2,?32,B3,?65,B4

 +6        QUIT