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 Nov 22, 2024@17:06:01 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