FBAASTA.m

FBAASTA ;AISC/GRR-SIGNON STATUS DISPLAY ;28JUL86

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

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

 I '$D(^FBAA(161.4,1,0)) W !!,*7,"Site parameters must be entered before using the Fee system!",!,*7 Q

 K UL S $P(UL,"-",40)="-"

 I '$D(^FBAA(161.7,"AB","O",DUZ)) G NONE

SHOW D HED

 F J=0:0 S J=$O(^FBAA(161.7,"AB","O",DUZ,J)) Q:J'>0  I $D(^FBAA(161.7,J,0)) S Y(0)=^(0) D MORE

END K FBBN,FBBT,FBON,FBDO,J,UL Q

MORE S FBBN=$P(Y(0),"^",1),FBON=$P(Y(0),"^",2),FBBT=$P(Y(0),"^",3),FBDO=$P(Y(0),"^",4)

 W !,FBBN,?9,$S(FBBT="B3":"Medical",FBBT="B5":"Pharmacy",FBBT="B2":"Travel",FBBT="B9":"CH/CNH",1:"Unknown"),?21,FBON,?30,$E(FBDO,4,5),"/",$E(FBDO,6,7),"/",$E(FBDO,2,3)

 Q

NONE W !,*7,"You have no open Batches!!",!

 G END

HED D HOME^%ZIS W @IOF,"You currently have the following Batches Open",!!,"Batch",?9,"Batch",?19,"Obligation",?30," Date",!,"  #  ",?10,"Type",?22,"Number",?30,"Opened",!,UL,!

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBAASTA   957     printed  Apr 09, 2024@21:01:20                                                                                                                                                                                                      Page 2

FBAASTA   ;AISC/GRR-SIGNON STATUS DISPLAY ;28JUL86

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

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

 +3        IF '$DATA(^FBAA(161.4,1,0))

               WRITE !!,*7,"Site parameters must be entered before using the Fee system!",!,*7

               QUIT 

 +4        KILL UL

           SET $PIECE(UL,"-",40)="-"

 +5        IF '$DATA(^FBAA(161.7,"AB","O",DUZ))

               GOTO NONE

SHOW       DO HED

 +1        FOR J=0:0

               SET J=$ORDER(^FBAA(161.7,"AB","O",DUZ,J))

               if J'>0

                   QUIT 

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

                   SET Y(0)=^(0)

                   DO MORE

END        KILL FBBN,FBBT,FBON,FBDO,J,UL

           QUIT 

MORE       SET FBBN=$PIECE(Y(0),"^",1)

           SET FBON=$PIECE(Y(0),"^",2)

           SET FBBT=$PIECE(Y(0),"^",3)

           SET FBDO=$PIECE(Y(0),"^",4)

 +1        WRITE !,FBBN,?9,$SELECT(FBBT="B3":"Medical",FBBT="B5":"Pharmacy",FBBT="B2":"Travel",FBBT="B9":"CH/CNH",1:"Unknown"),?21,FBON,?30,$EXTRACT(FBDO,4,5),"/",$EXTRACT(FBDO,6,7),"/",$EXTRACT(FBDO,2,3)

 +2        QUIT 

NONE       WRITE !,*7,"You have no open Batches!!",!

 +1        GOTO END

HED        DO HOME^%ZIS

           WRITE @IOF,"You currently have the following Batches Open",!!,"Batch",?9,"Batch",?19,"Obligation",?30," Date",!,"  #  ",?10,"Type",?22,"Number",?30,"Opened",!,UL,!