FBAARB ;AISC/GRR,DMK - RE-OPEN BATCH PREVIOUSLY CLOSED ;7/10/14 15:22
;;3.5;FEE BASIS;**154**;JAN 30, 1995;Build 12
;;Per VA Directive 6402, this routine should not be modified.
BT W !!
S DIC="^FBAA(161.7,",DIC(0)="AEQMZ",DIC("S")=$S($D(^XUSEC("FBAA LEVEL 2",DUZ)):"I $G(^(""ST""))=""C""",1:"I $P(^(0),U,5)=DUZ&($G(^(""ST""))=""C"")")
D ^DIC K DIC G Q:X="^"!(X=""),BT:Y<0
S FBBAT=+Y,FBTYPE=$P(Y(0),U,3)
;FBBAT=ien of batch in 161.7 FBTYPE= batch type (B2,B3,B5,B9)
;reset payment line item total and total dollars
D CNTTOT(FBBAT)
S DIE="^FBAA(161.7,",DR="4////^S X=DUZ;4.5///@;10////^S X=FBLCNT;8////^S X=FBTOTAL;11////^S X=""O"";S:$G(FBTYPE)'=""B9"" Y="""";9////^S X=FBLCNT",DA=FBBAT
D ^DIE K DIE,DR
S:FBTOTAL=0 $P(^FBAA(161.7,+FBBAT,0),U,9)=""
S:FBLCNT=0 $P(^FBAA(161.7,+FBBAT,0),U,11)=""
W !! D EN^DIQ W !,"Batch has been Re-opened!" D Q G BT
;
Q K DA,FBLCNT,FBTOTAL,FBBAT,Y
Q
;
CNTTOT(B) ;called to determine line count and total dollars for a batch
; INPUT: B = IEN of batch in 161.7
; OUTPUT: FBLCNT = total line items in batch
; FBTOTAL= total dollars in batch
;
N A
S (FBLCNT,FBTOTAL)=0
Q:'$G(B)
Q:'$D(^FBAA(161.7,+B,0)) S A=$P($G(^(0)),U,3)
Q:A']""
D @A
Q
B2 ;travel batch use ^FBAAC("AD", to locate line items
N I,J
S (I,J)=0 F S I=$O(^FBAAC("AD",B,I)) Q:'I F S J=$O(^FBAAC("AD",B,I,J)) Q:'J I $D(^FBAAC(I,3,J,0)) D
. S FBLCNT=FBLCNT+1,FBTOTAL=FBTOTAL+$P(^(0),U,3)
Q
;
B3 ;outpatient batch use ^FBAAC("AC", to locate line items
N I,J,K,L
S (I,J,K,L)=0
F S I=$O(^FBAAC("AC",B,I)) Q:'I F S J=$O(^FBAAC("AC",B,I,J)) Q:'J F S K=$O(^FBAAC("AC",B,I,J,K)) Q:'K F S L=$O(^FBAAC("AC",B,I,J,K,L)) Q:'L I $D(^FBAAC(I,1,J,1,K,1,L,0)) D
. S FBLCNT=FBLCNT+1,FBTOTAL=FBTOTAL+$P(^(0),U,3)
Q
;
B5 ;pharmacy batch use ^FBAA(162.1,"AE", to locate line items
N I,J
S (I,J)=0
F S I=$O(^FBAA(162.1,"AE",B,I)) Q:'I F S J=$O(^FBAA(162.1,"AE",B,I,J)) Q:'J I $D(^FBAA(162.1,I,"RX",J,0)) D
. S FBLCNT=FBLCNT+1,FBTOTAL=FBTOTAL+$P(^(0),U,16)
Q
;
B9 ;inpatient batch use ^FBAAI("AC", to locate line items
N I
S I=0
F S I=$O(^FBAAI("AC",B,I)) Q:'I I $D(^FBAAI(I,0)) D
. S FBLCNT=FBLCNT+1,FBTOTAL=FBTOTAL+$P(^(0),U,9)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAARB 2234 printed Dec 13, 2024@01:56:19 Page 2
FBAARB ;AISC/GRR,DMK - RE-OPEN BATCH PREVIOUSLY CLOSED ;7/10/14 15:22
+1 ;;3.5;FEE BASIS;**154**;JAN 30, 1995;Build 12
+2 ;;Per VA Directive 6402, this routine should not be modified.
BT WRITE !!
+1 SET DIC="^FBAA(161.7,"
SET DIC(0)="AEQMZ"
SET DIC("S")=$SELECT($DATA(^XUSEC("FBAA LEVEL 2",DUZ)):"I $G(^(""ST""))=""C""",1:"I $P(^(0),U,5)=DUZ&($G(^(""ST""))=""C"")")
+2 DO ^DIC
KILL DIC
if X="^"!(X="")
GOTO Q
if Y<0
GOTO BT
+3 SET FBBAT=+Y
SET FBTYPE=$PIECE(Y(0),U,3)
+4 ;FBBAT=ien of batch in 161.7 FBTYPE= batch type (B2,B3,B5,B9)
+5 ;reset payment line item total and total dollars
+6 DO CNTTOT(FBBAT)
+7 SET DIE="^FBAA(161.7,"
SET DR="4////^S X=DUZ;4.5///@;10////^S X=FBLCNT;8////^S X=FBTOTAL;11////^S X=""O"";S:$G(FBTYPE)'=""B9"" Y="""";9////^S X=FBLCNT"
SET DA=FBBAT
+8 DO ^DIE
KILL DIE,DR
+9 if FBTOTAL=0
SET $PIECE(^FBAA(161.7,+FBBAT,0),U,9)=""
+10 if FBLCNT=0
SET $PIECE(^FBAA(161.7,+FBBAT,0),U,11)=""
+11 WRITE !!
DO EN^DIQ
WRITE !,"Batch has been Re-opened!"
DO Q
GOTO BT
+12 ;
Q KILL DA,FBLCNT,FBTOTAL,FBBAT,Y
+1 QUIT
+2 ;
CNTTOT(B) ;called to determine line count and total dollars for a batch
+1 ; INPUT: B = IEN of batch in 161.7
+2 ; OUTPUT: FBLCNT = total line items in batch
+3 ; FBTOTAL= total dollars in batch
+4 ;
+5 NEW A
+6 SET (FBLCNT,FBTOTAL)=0
+7 if '$GET(B)
QUIT
+8 if '$DATA(^FBAA(161.7,+B,0))
QUIT
SET A=$PIECE($GET(^(0)),U,3)
+9 if A']""
QUIT
+10 DO @A
+11 QUIT
B2 ;travel batch use ^FBAAC("AD", to locate line items
+1 NEW I,J
+2 SET (I,J)=0
FOR
SET I=$ORDER(^FBAAC("AD",B,I))
if 'I
QUIT
FOR
SET J=$ORDER(^FBAAC("AD",B,I,J))
if 'J
QUIT
IF $DATA(^FBAAC(I,3,J,0))
Begin DoDot:1
+3 SET FBLCNT=FBLCNT+1
SET FBTOTAL=FBTOTAL+$PIECE(^(0),U,3)
End DoDot:1
+4 QUIT
+5 ;
B3 ;outpatient batch use ^FBAAC("AC", to locate line items
+1 NEW I,J,K,L
+2 SET (I,J,K,L)=0
+3 FOR
SET I=$ORDER(^FBAAC("AC",B,I))
if 'I
QUIT
FOR
SET J=$ORDER(^FBAAC("AC",B,I,J))
if 'J
QUIT
FOR
SET K=$ORDER(^FBAAC("AC",B,I,J,K))
if 'K
QUIT
FOR
SET L=$ORDER(^FBAAC("AC",B,I,J,K,L))
if 'L
QUIT
IF $DATA(^FBAAC(I,1,J,1,K,1,L,0))
Begin DoDot:1
+4 SET FBLCNT=FBLCNT+1
SET FBTOTAL=FBTOTAL+$PIECE(^(0),U,3)
End DoDot:1
+5 QUIT
+6 ;
B5 ;pharmacy batch use ^FBAA(162.1,"AE", to locate line items
+1 NEW I,J
+2 SET (I,J)=0
+3 FOR
SET I=$ORDER(^FBAA(162.1,"AE",B,I))
if 'I
QUIT
FOR
SET J=$ORDER(^FBAA(162.1,"AE",B,I,J))
if 'J
QUIT
IF $DATA(^FBAA(162.1,I,"RX",J,0))
Begin DoDot:1
+4 SET FBLCNT=FBLCNT+1
SET FBTOTAL=FBTOTAL+$PIECE(^(0),U,16)
End DoDot:1
+5 QUIT
+6 ;
B9 ;inpatient batch use ^FBAAI("AC", to locate line items
+1 NEW I
+2 SET I=0
+3 FOR
SET I=$ORDER(^FBAAI("AC",B,I))
if 'I
QUIT
IF $DATA(^FBAAI(I,0))
Begin DoDot:1
+4 SET FBLCNT=FBLCNT+1
SET FBTOTAL=FBTOTAL+$PIECE(^(0),U,9)
End DoDot:1
+5 QUIT
