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