FBAAOB ;AISC/GRR-OPEN BATCHES ;29JUL86
 ;;3.5;FEE BASIS;;JAN 30, 1995
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 D:'$D(DT) DT^DICRW D:'$D(FBSITE(1)) SITEP^FBAAUTL G:+$G(FBPOP) KILL
 I '$D(^FBAA(161.4,1,0)) W !!,*7,"Site Parameters have not been entered. Must be entered",!,"before using this option",! Q
 S DIC="^FBAA(161.7,",DIC(0)="LQ",DLAYGO=161.7
RMED S DIR(0)="Y",DIR("A")="Want to create a Medical batch",DIR("B")="YES" D ^DIR K DIR G:$D(DIRUT) KILL I Y D MED,KILL Q
RPHARM S DIR(0)="Y",DIR("A")="Want to create a Pharmacy Batch",DIR("B")="YES" D ^DIR K DIR G:$D(DIRUT) KILL I Y D PHARM,KILL Q
 Q:$D(FBPHOPT)
RTRAV S DIR(0)="Y",DIR("A")="Want to create a Travel Batch",DIR("B")="YES" D ^DIR K DIR G:$D(DIRUT) KILL I Y D TRAV,KILL Q
 D KILL Q
TRAV D GETNXB^FBAAUTL W !!,"Travel Batch number assigned is: ",FBBN
 W !! S X=FBBN,DIC(0)="LEQ",(DIE,DIC)="^FBAA(161.7,",DIC("DR")="",DLAYGO=161.7 D ^DIC K DLAYGO G:Y<0 UHOH S FBDA=+Y
 D GETOB Q:'$D(FBSTN)  S DA=FBDA,DR="[FBAA TRAV IFCAP]" D ^DIE,KILL
 Q
MED D GETNXB^FBAAUTL W !!,"Medical Batch number assigned is: ",FBBN
 W !! S X=FBBN,DIC(0)="LEQ",(DIE,DIC)="^FBAA(161.7,",DIC("DR")="",DLAYGO=161.7 D ^DIC K DLAYGO G:Y<0 UHOH S FBDA=+Y,FBY=Y K DR
 D GETOB Q:'$D(FBSTN)  S DA=FBDA,DR="[FBAA MED IFCAP]" D ^DIE,KILL
 Q
PHARM D GETNXB^FBAAUTL W !!,"Pharmacy Batch number assigned is: ",FBBN
 W !! S X=FBBN,DLAYGO=161.7,DIC(0)="LEQ",(DIE,DIC)="^FBAA(161.7,",DIC("DR")="" D ^DIC G:Y<0 UHOH S FBDA=+Y,FBY=Y K DR,DLAYGO
 D GETOB Q:'$D(FBSTN)  S DA=FBDA,DR="[FBAA PHARM IFCAP]" D ^DIE,KILL
 Q
RCHNH I '$D(FBSITE(1)) D SITEP^FBAAUTL G:FBPOP KILL
 S DIR(0)="Y",DIR("A")="Want to create a Community Nursing Home batch",DIR("B")="YES" D ^DIR K DIR G:$D(DIRUT) KILL I Y D CHNH,KILL
 D KILL Q
CHNH D GETNXB^FBAAUTL W !!,"Batch number assigned is: ",FBBN
 W !! S X=FBBN,DLAYGO=161.7,DIC(0)="LQ",(DIE,DIC)="^FBAA(161.7,",DIC("DR")="" D ^DIC G:Y<0 UHOH S FBDA=+Y K DR,DLAYGO
 D GETOB Q:'$D(FBSTN)  S DA=FBDA,DR="[FB CHNH OPEN BATCH]" D ^DIE,KILL
 Q
GETOB S PRCS("A")="Select Obligation Number: " K PRCS("X"),DR S PRCS("TYPE")="FB" D EN1^PRCS58 G:Y=-1 BACKOUT S FBSTN=$E($P(Y,"^",2),1,3),FBOBN=$P($P(Y,"^",2),"-",2) K PRCS D:$S($G(FBSTN)']"":1,$G(FBOBN)']"":1,1:0) BACKOUT Q
 ;
BACKOUT S DIK="^FBAA(161.7,",DA=FBDA D ^DIK W !,*7,"Batch # ",FBBN," deleted because Obligation number was not selected!",!,"You must be an authorized user in IFCAP package to select an obligation." K FBSTN Q
 ;
RCHOP I '$D(FBSITE(1)) D SITEP^FBAAUTL G:FBPOP KILL
 S DIR(0)="Y",DIR("A")="Want to create a Contract Hospital Batch",DIR("B")="YES" D ^DIR K DIR G:$D(DIRUT)!('Y) KILL I Y D CH
 ;FBAABE is set from FBCHEP to ask user to open a new batch
 I $D(FBAABE) S FBAABE=FBDA
 D KILL Q
CH D GETNXB^FBAAUTL W !!,"Batch number assigned is: ",FBBN
 S DLAYGO=161.7
 W !! S X=FBBN,DIC(0)="LQ",(DIE,DIC)="^FBAA(161.7,",DIC("DR")="",DLAYGO=161.7 D ^DIC G:Y<0 UHOH S FBDA=+Y K DR,DLAYGO
 D GETOB Q:'$D(FBSTN)  S DA=FBDA,DR="[FB CH OPEN BATCH]" D ^DIE
 Q
ANCOB I '$D(FBSITE(1)) D SITEP^FBAAUTL G:FBPOP KILL
 S DLAYGO=161.7
 S DIR(0)="Y",DIR("A")="Want to create an Ancillary Payment Medical Batch",DIR("B")="YES" D ^DIR K DIR G:$D(DIRUT) KILL I Y D MED,KILL
 D KILL Q
UHOH W !!,*7,"Batch was not created!" Q
KILL K DA,D,DR,DIC,DIE,DIK,FBDA,FBOBN,FBPOP,FBSTN,FBSITE,Y,FBY,PRC,X,FBBN,Z,DLAYGO,D0,DQ,DIRUT,PRCSCPAN
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAOB   3396     printed  Sep 23, 2025@19:31:55                                                                                                                                                                                                      Page 2
FBAAOB    ;AISC/GRR-OPEN BATCHES ;29JUL86
 +1       ;;3.5;FEE BASIS;;JAN 30, 1995
 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.
 +3        if '$DATA(DT)
               DO DT^DICRW
           if '$DATA(FBSITE(1))
               DO SITEP^FBAAUTL
           if +$GET(FBPOP)
               GOTO KILL
 +4        IF '$DATA(^FBAA(161.4,1,0))
               WRITE !!,*7,"Site Parameters have not been entered. Must be entered",!,"before using this option",!
               QUIT 
 +5        SET DIC="^FBAA(161.7,"
           SET DIC(0)="LQ"
           SET DLAYGO=161.7
RMED       SET DIR(0)="Y"
           SET DIR("A")="Want to create a Medical batch"
           SET DIR("B")="YES"
           DO ^DIR
           KILL DIR
           if $DATA(DIRUT)
               GOTO KILL
           IF Y
               DO MED
               DO KILL
               QUIT 
RPHARM     SET DIR(0)="Y"
           SET DIR("A")="Want to create a Pharmacy Batch"
           SET DIR("B")="YES"
           DO ^DIR
           KILL DIR
           if $DATA(DIRUT)
               GOTO KILL
           IF Y
               DO PHARM
               DO KILL
               QUIT 
 +1        if $DATA(FBPHOPT)
               QUIT 
RTRAV      SET DIR(0)="Y"
           SET DIR("A")="Want to create a Travel Batch"
           SET DIR("B")="YES"
           DO ^DIR
           KILL DIR
           if $DATA(DIRUT)
               GOTO KILL
           IF Y
               DO TRAV
               DO KILL
               QUIT 
 +1        DO KILL
           QUIT 
TRAV       DO GETNXB^FBAAUTL
           WRITE !!,"Travel Batch number assigned is: ",FBBN
 +1        WRITE !!
           SET X=FBBN
           SET DIC(0)="LEQ"
           SET (DIE,DIC)="^FBAA(161.7,"
           SET DIC("DR")=""
           SET DLAYGO=161.7
           DO ^DIC
           KILL DLAYGO
           if Y<0
               GOTO UHOH
           SET FBDA=+Y
 +2        DO GETOB
           if '$DATA(FBSTN)
               QUIT 
           SET DA=FBDA
           SET DR="[FBAA TRAV IFCAP]"
           DO ^DIE
           DO KILL
 +3        QUIT 
MED        DO GETNXB^FBAAUTL
           WRITE !!,"Medical Batch number assigned is: ",FBBN
 +1        WRITE !!
           SET X=FBBN
           SET DIC(0)="LEQ"
           SET (DIE,DIC)="^FBAA(161.7,"
           SET DIC("DR")=""
           SET DLAYGO=161.7
           DO ^DIC
           KILL DLAYGO
           if Y<0
               GOTO UHOH
           SET FBDA=+Y
           SET FBY=Y
           KILL DR
 +2        DO GETOB
           if '$DATA(FBSTN)
               QUIT 
           SET DA=FBDA
           SET DR="[FBAA MED IFCAP]"
           DO ^DIE
           DO KILL
 +3        QUIT 
PHARM      DO GETNXB^FBAAUTL
           WRITE !!,"Pharmacy Batch number assigned is: ",FBBN
 +1        WRITE !!
           SET X=FBBN
           SET DLAYGO=161.7
           SET DIC(0)="LEQ"
           SET (DIE,DIC)="^FBAA(161.7,"
           SET DIC("DR")=""
           DO ^DIC
           if Y<0
               GOTO UHOH
           SET FBDA=+Y
           SET FBY=Y
           KILL DR,DLAYGO
 +2        DO GETOB
           if '$DATA(FBSTN)
               QUIT 
           SET DA=FBDA
           SET DR="[FBAA PHARM IFCAP]"
           DO ^DIE
           DO KILL
 +3        QUIT 
RCHNH      IF '$DATA(FBSITE(1))
               DO SITEP^FBAAUTL
               if FBPOP
                   GOTO KILL
 +1        SET DIR(0)="Y"
           SET DIR("A")="Want to create a Community Nursing Home batch"
           SET DIR("B")="YES"
           DO ^DIR
           KILL DIR
           if $DATA(DIRUT)
               GOTO KILL
           IF Y
               DO CHNH
               DO KILL
 +2        DO KILL
           QUIT 
CHNH       DO GETNXB^FBAAUTL
           WRITE !!,"Batch number assigned is: ",FBBN
 +1        WRITE !!
           SET X=FBBN
           SET DLAYGO=161.7
           SET DIC(0)="LQ"
           SET (DIE,DIC)="^FBAA(161.7,"
           SET DIC("DR")=""
           DO ^DIC
           if Y<0
               GOTO UHOH
           SET FBDA=+Y
           KILL DR,DLAYGO
 +2        DO GETOB
           if '$DATA(FBSTN)
               QUIT 
           SET DA=FBDA
           SET DR="[FB CHNH OPEN BATCH]"
           DO ^DIE
           DO KILL
 +3        QUIT 
GETOB      SET PRCS("A")="Select Obligation Number: "
           KILL PRCS("X"),DR
           SET PRCS("TYPE")="FB"
           DO EN1^PRCS58
           if Y=-1
               GOTO BACKOUT
           SET FBSTN=$EXTRACT($PIECE(Y,"^",2),1,3)
           SET FBOBN=$PIECE($PIECE(Y,"^",2),"-",2)
           KILL PRCS
           if $SELECT($GET(FBSTN)']""
               DO BACKOUT
           QUIT 
 +1       ;
BACKOUT    SET DIK="^FBAA(161.7,"
           SET DA=FBDA
           DO ^DIK
           WRITE !,*7,"Batch # ",FBBN," deleted because Obligation number was not selected!",!,"You must be an authorized user in IFCAP package to select an obligation."
           KILL FBSTN
           QUIT 
 +1       ;
RCHOP      IF '$DATA(FBSITE(1))
               DO SITEP^FBAAUTL
               if FBPOP
                   GOTO KILL
 +1        SET DIR(0)="Y"
           SET DIR("A")="Want to create a Contract Hospital Batch"
           SET DIR("B")="YES"
           DO ^DIR
           KILL DIR
           if $DATA(DIRUT)!('Y)
               GOTO KILL
           IF Y
               DO CH
 +2       ;FBAABE is set from FBCHEP to ask user to open a new batch
 +3        IF $DATA(FBAABE)
               SET FBAABE=FBDA
 +4        DO KILL
           QUIT 
CH         DO GETNXB^FBAAUTL
           WRITE !!,"Batch number assigned is: ",FBBN
 +1        SET DLAYGO=161.7
 +2        WRITE !!
           SET X=FBBN
           SET DIC(0)="LQ"
           SET (DIE,DIC)="^FBAA(161.7,"
           SET DIC("DR")=""
           SET DLAYGO=161.7
           DO ^DIC
           if Y<0
               GOTO UHOH
           SET FBDA=+Y
           KILL DR,DLAYGO
 +3        DO GETOB
           if '$DATA(FBSTN)
               QUIT 
           SET DA=FBDA
           SET DR="[FB CH OPEN BATCH]"
           DO ^DIE
 +4        QUIT 
ANCOB      IF '$DATA(FBSITE(1))
               DO SITEP^FBAAUTL
               if FBPOP
                   GOTO KILL
 +1        SET DLAYGO=161.7
 +2        SET DIR(0)="Y"
           SET DIR("A")="Want to create an Ancillary Payment Medical Batch"
           SET DIR("B")="YES"
           DO ^DIR
           KILL DIR
           if $DATA(DIRUT)
               GOTO KILL
           IF Y
               DO MED
               DO KILL
 +3        DO KILL
           QUIT 
UHOH       WRITE !!,*7,"Batch was not created!"
           QUIT 
KILL       KILL DA,D,DR,DIC,DIE,DIK,FBDA,FBOBN,FBPOP,FBSTN,FBSITE,Y,FBY,PRC,X,FBBN,Z,DLAYGO,D0,DQ,DIRUT,PRCSCPAN
 +1        QUIT