- 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 Mar 13, 2025@21:01:02 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
