FBAARR ;AISC/GRR - REINITIATE REJECTED LINE ITEMS ; 4/6/2012
;;3.5;FEE BASIS;**61,114,132**;JAN 30, 1995;Build 17
;;Per VHA Directive 2004-038, this routine should not be modified.
N FBILM
S IOP=$S($D(ION):ION,1:"HOME") D ^%ZIS K IOP
S Q="",$P(Q,"=",80)="=",UL="",$P(UL,"-",80)="-",(FBAAOUT,CNT,FBINTOT)=0
D DT^DICRW
BT K QQ W !!
S DIC="^FBAA(161.7,",DIC(0)="AEQMN",DIC("A")="Select Batch with Rejects: ",DIC("S")="I $G(^(""ST""))=""V""&($P(^(0),U,17)]"""")" D ^DIC K DIC("S"),DIC("A") G Q:X="^"!(X=""),BT:Y<0
L +^FBAA(161.7,+Y):$G(DILOCKTM,3)
I '$T W !,"Another user is editing this batch. Try again later." G BT
S FBN=+Y,B=FBN,FZ=^FBAA(161.7,FBN,0),FBTYPE=$P(FZ,"^",3)
S FBOB=$P(FZ,"^",2),FBEXMPT=$S($P(FZ,"^",18)]"":$P(FZ,"^",18),1:"N")
I '$S(FBTYPE="B3":$D(^FBAAC("AH",B)),FBTYPE="B2":$D(^FBAAC("AG",B)),FBTYPE="B5":$D(^FBAA(162.1,"AF",B)),FBTYPE="B9":$D(^FBAAI("AH",B)),1:0) W !!,*7,"No items rejected in this batch!" D D UNLK G BT
.S $P(^FBAA(161.7,B,0),U,17)=""
;
I "^P^E^"[(U_$$GET1^DIQ(161.7,FBN_",",22,"I")_U) D D UNLK G BT
. W !,"This batch cannot be re-initiated yet. The Voucher Batch"
. W !,"Message must first be successfully acknowledged by Central Fee."
;
I FBTYPE="B9",$P(FZ,"^",15)="Y" D NEWBT^FBAARR0 G ASKLL
BTN W !! S DIC("A")="Select New Batch number: ",DIC("S")="I $P(^(0),U,3)=FBTYPE&($P(^(0),U,5)=DUZ)&($G(^(""ST""))=""O"")" D ^DIC K DIC("A"),DIC("S") G Q:X=""!(X="^"),HELP^FBAARR0:X["?",BTN:Y<0 S FBNB=+Y
D BATCNT^FBAARR1 I '$D(FBNB) D UNLK G BT
S FBNUM=$P(^FBAA(161.7,B,0),"^",1),FBVD=$P(^(0),"^",12),FBVDUZ=$P(^(0),"^",16),FBNOB=$P(^FBAA(161.7,FBNB,0),"^",2) G:FBNOB'=FBOB CHKOB^FBAARR0
ASKLL S B=FBN,FBNNP=1 S DIR(0)="Y",DIR("A")="Want line items listed",DIR("B")="NO" D ^DIR K DIR W:Y @IOF D:Y MORE^FBAARJP:FBTYPE="B3",PMORE^FBAARJP:FBTYPE="B5",TMORE^FBAARJP:FBTYPE="B2",CMORE^FBAARJP:FBTYPE="B9" K FBNNP
RD0 S DIR(0)="Y",DIR("A")="Want to re-initiate all rejected items in the Batch",DIR("B")="NO",DIR("?")="'Yes' will re-initiate all rejected payment items for this batch, 'No' will prompt for re-initiation of specific line items"
D ^DIR K DIR G:Y ^FBAARR1
RD1 S DIR(0)="Y",DIR("A")="Want to re-initiate any line items",DIR("B")="NO" D ^DIR K DIR Q:$D(DIRUT)!'Y D DELT^FBAARR2:FBTYPE="B2",DELM:FBTYPE="B3",DELP^FBAARR2:FBTYPE="B5",DELC^FBAARR0:FBTYPE="B9"
RDD ;
S DIC="^FBAA(161.7,",DA=FBN,DR="0:1;ST" W !! D EN^DIQ
D UNLK
G BT
Q ; clean up
D UNLK
D KILL^FBAARR1
Q
UNLK ; unlock batch
I $G(FBN) L -^FBAA(161.7,FBN)
Q
DELM ; specify line items to re-initiate for batch type B3
; select patient
S J=$$ASKVET^FBAAUTL1("I $D(^FBAAC(""AH"",B,+Y))")
Q:'J
K QQ
S QQ=0 W @IOF D HED^FBAACCB
F K=0:0 S K=$O(^FBAAC("AH",B,J,K)) Q:K'>0 F L=0:0 S L=$O(^FBAAC("AH",B,J,K,L)) Q:L'>0 F M=0:0 S M=$O(^FBAAC("AH",B,J,K,L,M)) Q:M'>0 D WRITM
RL S ERR=0 S DIR(0)="N^1:"_QQ,DIR("A")="Re-initiate which line item" D ^DIR K DIR G:$D(DIRUT) END S HX=X
I '$D(QQ(HX)) W !,*7,"You already did that one!!" G RL
ASKSU S DIR(0)="Y",DIR("A")="Are you sure you want to re-initiate line item number "_HX,DIR("B")="NO" D ^DIR K DIR G:$D(DIRUT)!'Y RL
S J=$P(QQ(HX),"^",1),K=$P(QQ(HX),"^",2),L=$P(QQ(HX),"^",3),M=$P(QQ(HX),"^",4)
K FBERR
D REJM^FBAARR1
ASKRI S DIR(0)="Y",DIR("A")=$S($G(FBERR):"",1:"Item Re-initiated. ")_"Want to re-initiate another",DIR("B")="YES" D ^DIR K DIR G ASKRI:$D(DIRUT),DELM:Y,END
WRITM S QQ=QQ+1,QQ(QQ)=J_"^"_K_"^"_L_"^"_M D SET^FBAACCB Q
END ;
; Assign new invoice number to moved lines if invoice was split
I $$CKSPLIT(B,.FBILM) S DIR(0)="E" D ^DIR K DIR
Q
CKSPLIT(B,FBILM) ; Check for/Update split invoice
; Input
; B - ien of original batch before item moved
; FBILM( - array of invoice lines that were moved to a new batch
; passed by reference
; format FBILM(invoice number,iens)=""
; where
; invoice number = invoice number
; iens = iens of subfile 162.03 (a line item)
; Result (0 or 1)
; =0 if no lines were assigned a new invoice number
; =1 if some lines assigned a new invoice number
; May change invoice number of line items in subfile 162.03
; and inform user
N FBAAIN,FBFDA,FBIENS,FBIN,FBINL,FBJ,FBK,FBL,FBM,FBRET,FBSPLT
S FBRET=0
; loop thru invoice numbers in input array
S FBIN="" F S FBIN=$O(FBILM(FBIN)) Q:FBIN="" D
. S FBSPLT=0 ; initialize split flag to false
. ; check if any unrejected invoice lines still in original batch
. I $D(^FBAAC("AJ",B,FBIN)) S FBSPLT=1
. ; check if any rejected invoice lines still in original batch
. I 'FBSPLT S FBJ=0 F S FBJ=$O(^FBAAC("AH",B,FBJ)) Q:'FBJ D Q:FBSPLT
. . S FBK=0
. . F S FBK=$O(^FBAAC("AH",B,FBJ,FBK)) Q:'FBK D Q:FBSPLT
. . . S FBL=0
. . . F S FBL=$O(^FBAAC("AH",B,FBJ,FBK,FBL)) Q:'FBL D Q:FBSPLT
. . . . S FBM=0
. . . . F S FBM=$O(^FBAAC("AH",B,FBJ,FBK,FBL,FBM)) Q:'FBM D Q:FBSPLT
. . . . . S FBINL=$P($G(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,0)),U,16)
. . . . . I FBINL=FBIN S FBSPLT=1
. Q:FBSPLT=0 ; invoice was not split
. S FBRET=1
. ; assign new invoice number to lines moved to the new batch
. ; get a new invoice number (FBAAIN)
. D GETNXI^FBAAUTL
. ; loop thru the moved line items and assign the new invoice number
. K FBFDA
. S FBIENS="" F S FBIENS=$O(FBILM(FBIN,FBIENS)) Q:FBIENS="" D
. . S FBFDA(162.03,FBIENS,14)=FBAAIN
. W !!,"FYI: Invoice ",FBIN," was split since entire invoice did not move to the new batch."
. W !,"Re-initiated lines are being assigned a new invoice number of ",FBAAIN,"."
. ; update the file
. I $D(FBFDA) D FILE^DIE("","FBFDA"),MSG^DIALOG()
Q FBRET
;
;FBAARR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAARR 5654 printed Oct 16, 2024@17:57:18 Page 2
FBAARR ;AISC/GRR - REINITIATE REJECTED LINE ITEMS ; 4/6/2012
+1 ;;3.5;FEE BASIS;**61,114,132**;JAN 30, 1995;Build 17
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 NEW FBILM
+4 SET IOP=$SELECT($DATA(ION):ION,1:"HOME")
DO ^%ZIS
KILL IOP
+5 SET Q=""
SET $PIECE(Q,"=",80)="="
SET UL=""
SET $PIECE(UL,"-",80)="-"
SET (FBAAOUT,CNT,FBINTOT)=0
+6 DO DT^DICRW
BT KILL QQ
WRITE !!
+1 SET DIC="^FBAA(161.7,"
SET DIC(0)="AEQMN"
SET DIC("A")="Select Batch with Rejects: "
SET DIC("S")="I $G(^(""ST""))=""V""&($P(^(0),U,17)]"""")"
DO ^DIC
KILL DIC("S"),DIC("A")
if X="^"!(X="")
GOTO Q
if Y<0
GOTO BT
+2 LOCK +^FBAA(161.7,+Y):$GET(DILOCKTM,3)
+3 IF '$TEST
WRITE !,"Another user is editing this batch. Try again later."
GOTO BT
+4 SET FBN=+Y
SET B=FBN
SET FZ=^FBAA(161.7,FBN,0)
SET FBTYPE=$PIECE(FZ,"^",3)
+5 SET FBOB=$PIECE(FZ,"^",2)
SET FBEXMPT=$SELECT($PIECE(FZ,"^",18)]"":$PIECE(FZ,"^",18),1:"N")
+6 IF '$SELECT(FBTYPE="B3":$DATA(^FBAAC("AH",B)),FBTYPE="B2":$DATA(^FBAAC("AG",B)),FBTYPE="B5":$DATA(^FBAA(162.1,"AF",B)),FBTYPE="B9":$DATA(^FBAAI("AH",B)),1:0)
WRITE !!,*7,"No items rejected in this batch!"
Begin DoDot:1
+7 SET $PIECE(^FBAA(161.7,B,0),U,17)=""
End DoDot:1
DO UNLK
GOTO BT
+8 ;
+9 IF "^P^E^"[(U_$$GET1^DIQ(161.7,FBN_",",22,"I")_U)
Begin DoDot:1
+10 WRITE !,"This batch cannot be re-initiated yet. The Voucher Batch"
+11 WRITE !,"Message must first be successfully acknowledged by Central Fee."
End DoDot:1
DO UNLK
GOTO BT
+12 ;
+13 IF FBTYPE="B9"
IF $PIECE(FZ,"^",15)="Y"
DO NEWBT^FBAARR0
GOTO ASKLL
BTN WRITE !!
SET DIC("A")="Select New Batch number: "
SET DIC("S")="I $P(^(0),U,3)=FBTYPE&($P(^(0),U,5)=DUZ)&($G(^(""ST""))=""O"")"
DO ^DIC
KILL DIC("A"),DIC("S")
if X=""!(X="^")
GOTO Q
if X["?"
GOTO HELP^FBAARR0
if Y<0
GOTO BTN
SET FBNB=+Y
+1 DO BATCNT^FBAARR1
IF '$DATA(FBNB)
DO UNLK
GOTO BT
+2 SET FBNUM=$PIECE(^FBAA(161.7,B,0),"^",1)
SET FBVD=$PIECE(^(0),"^",12)
SET FBVDUZ=$PIECE(^(0),"^",16)
SET FBNOB=$PIECE(^FBAA(161.7,FBNB,0),"^",2)
if FBNOB'=FBOB
GOTO CHKOB^FBAARR0
ASKLL SET B=FBN
SET FBNNP=1
SET DIR(0)="Y"
SET DIR("A")="Want line items listed"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
if Y
WRITE @IOF
if Y
if FBTYPE="B3"
DO MORE^FBAARJP
if FBTYPE="B5"
DO PMORE^FBAARJP
if FBTYPE="B2"
DO TMORE^FBAARJP
if FBTYPE="B9"
DO CMORE^FBAARJP
KILL FBNNP
RD0 SET DIR(0)="Y"
SET DIR("A")="Want to re-initiate all rejected items in the Batch"
SET DIR("B")="NO"
SET DIR("?")="'Yes' will re-initiate all rejected payment items for this batch, 'No' will prompt for re-initiation of specific line items"
+1 DO ^DIR
KILL DIR
if Y
GOTO ^FBAARR1
RD1 SET DIR(0)="Y"
SET DIR("A")="Want to re-initiate any line items"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
if $DATA(DIRUT)!'Y
QUIT
if FBTYPE="B2"
DO DELT^FBAARR2
if FBTYPE="B3"
DO DELM
if FBTYPE="B5"
DO DELP^FBAARR2
if FBTYPE="B9"
DO DELC^FBAARR0
RDD ;
+1 SET DIC="^FBAA(161.7,"
SET DA=FBN
SET DR="0:1;ST"
WRITE !!
DO EN^DIQ
+2 DO UNLK
+3 GOTO BT
Q ; clean up
+1 DO UNLK
+2 DO KILL^FBAARR1
+3 QUIT
UNLK ; unlock batch
+1 IF $GET(FBN)
LOCK -^FBAA(161.7,FBN)
+2 QUIT
DELM ; specify line items to re-initiate for batch type B3
+1 ; select patient
+2 SET J=$$ASKVET^FBAAUTL1("I $D(^FBAAC(""AH"",B,+Y))")
+3 if 'J
QUIT
+4 KILL QQ
+5 SET QQ=0
WRITE @IOF
DO HED^FBAACCB
+6 FOR K=0:0
SET K=$ORDER(^FBAAC("AH",B,J,K))
if K'>0
QUIT
FOR L=0:0
SET L=$ORDER(^FBAAC("AH",B,J,K,L))
if L'>0
QUIT
FOR M=0:0
SET M=$ORDER(^FBAAC("AH",B,J,K,L,M))
if M'>0
QUIT
DO WRITM
RL SET ERR=0
SET DIR(0)="N^1:"_QQ
SET DIR("A")="Re-initiate which line item"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO END
SET HX=X
+1 IF '$DATA(QQ(HX))
WRITE !,*7,"You already did that one!!"
GOTO RL
ASKSU SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to re-initiate line item number "_HX
SET DIR("B")="NO"
DO ^DIR
KILL DIR
if $DATA(DIRUT)!'Y
GOTO RL
+1 SET J=$PIECE(QQ(HX),"^",1)
SET K=$PIECE(QQ(HX),"^",2)
SET L=$PIECE(QQ(HX),"^",3)
SET M=$PIECE(QQ(HX),"^",4)
+2 KILL FBERR
+3 DO REJM^FBAARR1
ASKRI SET DIR(0)="Y"
SET DIR("A")=$SELECT($GET(FBERR):"",1:"Item Re-initiated. ")_"Want to re-initiate another"
SET DIR("B")="YES"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO ASKRI
if Y
GOTO DELM
GOTO END
WRITM SET QQ=QQ+1
SET QQ(QQ)=J_"^"_K_"^"_L_"^"_M
DO SET^FBAACCB
QUIT
END ;
+1 ; Assign new invoice number to moved lines if invoice was split
+2 IF $$CKSPLIT(B,.FBILM)
SET DIR(0)="E"
DO ^DIR
KILL DIR
+3 QUIT
CKSPLIT(B,FBILM) ; Check for/Update split invoice
+1 ; Input
+2 ; B - ien of original batch before item moved
+3 ; FBILM( - array of invoice lines that were moved to a new batch
+4 ; passed by reference
+5 ; format FBILM(invoice number,iens)=""
+6 ; where
+7 ; invoice number = invoice number
+8 ; iens = iens of subfile 162.03 (a line item)
+9 ; Result (0 or 1)
+10 ; =0 if no lines were assigned a new invoice number
+11 ; =1 if some lines assigned a new invoice number
+12 ; May change invoice number of line items in subfile 162.03
+13 ; and inform user
+14 NEW FBAAIN,FBFDA,FBIENS,FBIN,FBINL,FBJ,FBK,FBL,FBM,FBRET,FBSPLT
+15 SET FBRET=0
+16 ; loop thru invoice numbers in input array
+17 SET FBIN=""
FOR
SET FBIN=$ORDER(FBILM(FBIN))
if FBIN=""
QUIT
Begin DoDot:1
+18 ; initialize split flag to false
SET FBSPLT=0
+19 ; check if any unrejected invoice lines still in original batch
+20 IF $DATA(^FBAAC("AJ",B,FBIN))
SET FBSPLT=1
+21 ; check if any rejected invoice lines still in original batch
+22 IF 'FBSPLT
SET FBJ=0
FOR
SET FBJ=$ORDER(^FBAAC("AH",B,FBJ))
if 'FBJ
QUIT
Begin DoDot:2
+23 SET FBK=0
+24 FOR
SET FBK=$ORDER(^FBAAC("AH",B,FBJ,FBK))
if 'FBK
QUIT
Begin DoDot:3
+25 SET FBL=0
+26 FOR
SET FBL=$ORDER(^FBAAC("AH",B,FBJ,FBK,FBL))
if 'FBL
QUIT
Begin DoDot:4
+27 SET FBM=0
+28 FOR
SET FBM=$ORDER(^FBAAC("AH",B,FBJ,FBK,FBL,FBM))
if 'FBM
QUIT
Begin DoDot:5
+29 SET FBINL=$PIECE($GET(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,0)),U,16)
+30 IF FBINL=FBIN
SET FBSPLT=1
End DoDot:5
if FBSPLT
QUIT
End DoDot:4
if FBSPLT
QUIT
End DoDot:3
if FBSPLT
QUIT
End DoDot:2
if FBSPLT
QUIT
+31 ; invoice was not split
if FBSPLT=0
QUIT
+32 SET FBRET=1
+33 ; assign new invoice number to lines moved to the new batch
+34 ; get a new invoice number (FBAAIN)
+35 DO GETNXI^FBAAUTL
+36 ; loop thru the moved line items and assign the new invoice number
+37 KILL FBFDA
+38 SET FBIENS=""
FOR
SET FBIENS=$ORDER(FBILM(FBIN,FBIENS))
if FBIENS=""
QUIT
Begin DoDot:2
+39 SET FBFDA(162.03,FBIENS,14)=FBAAIN
End DoDot:2
+40 WRITE !!,"FYI: Invoice ",FBIN," was split since entire invoice did not move to the new batch."
+41 WRITE !,"Re-initiated lines are being assigned a new invoice number of ",FBAAIN,"."
+42 ; update the file
+43 IF $DATA(FBFDA)
DO FILE^DIE("","FBFDA")
DO MSG^DIALOG()
End DoDot:1
+44 QUIT FBRET
+45 ;
+46 ;FBAARR
