- 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 Feb 18, 2025@23:22:17 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