Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FBAARR

FBAARR.m

Go to the documentation of this file.
  1. FBAARR ;AISC/GRR - REINITIATE REJECTED LINE ITEMS ; 4/6/2012
  1. ;;3.5;FEE BASIS;**61,114,132**;JAN 30, 1995;Build 17
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. N FBILM
  1. S IOP=$S($D(ION):ION,1:"HOME") D ^%ZIS K IOP
  1. S Q="",$P(Q,"=",80)="=",UL="",$P(UL,"-",80)="-",(FBAAOUT,CNT,FBINTOT)=0
  1. D DT^DICRW
  1. BT K QQ W !!
  1. 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
  1. L +^FBAA(161.7,+Y):$G(DILOCKTM,3)
  1. I '$T W !,"Another user is editing this batch. Try again later." G BT
  1. S FBN=+Y,B=FBN,FZ=^FBAA(161.7,FBN,0),FBTYPE=$P(FZ,"^",3)
  1. S FBOB=$P(FZ,"^",2),FBEXMPT=$S($P(FZ,"^",18)]"":$P(FZ,"^",18),1:"N")
  1. 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
  1. .S $P(^FBAA(161.7,B,0),U,17)=""
  1. ;
  1. I "^P^E^"[(U_$$GET1^DIQ(161.7,FBN_",",22,"I")_U) D D UNLK G BT
  1. . W !,"This batch cannot be re-initiated yet. The Voucher Batch"
  1. . W !,"Message must first be successfully acknowledged by Central Fee."
  1. ;
  1. I FBTYPE="B9",$P(FZ,"^",15)="Y" D NEWBT^FBAARR0 G ASKLL
  1. 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
  1. D BATCNT^FBAARR1 I '$D(FBNB) D UNLK G BT
  1. 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
  1. 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
  1. 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"
  1. D ^DIR K DIR G:Y ^FBAARR1
  1. 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"
  1. RDD ;
  1. S DIC="^FBAA(161.7,",DA=FBN,DR="0:1;ST" W !! D EN^DIQ
  1. D UNLK
  1. G BT
  1. Q ; clean up
  1. D UNLK
  1. D KILL^FBAARR1
  1. Q
  1. UNLK ; unlock batch
  1. I $G(FBN) L -^FBAA(161.7,FBN)
  1. Q
  1. DELM ; specify line items to re-initiate for batch type B3
  1. ; select patient
  1. S J=$$ASKVET^FBAAUTL1("I $D(^FBAAC(""AH"",B,+Y))")
  1. Q:'J
  1. K QQ
  1. S QQ=0 W @IOF D HED^FBAACCB
  1. 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
  1. 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
  1. I '$D(QQ(HX)) W !,*7,"You already did that one!!" G RL
  1. 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
  1. S J=$P(QQ(HX),"^",1),K=$P(QQ(HX),"^",2),L=$P(QQ(HX),"^",3),M=$P(QQ(HX),"^",4)
  1. K FBERR
  1. D REJM^FBAARR1
  1. 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
  1. WRITM S QQ=QQ+1,QQ(QQ)=J_"^"_K_"^"_L_"^"_M D SET^FBAACCB Q
  1. END ;
  1. ; Assign new invoice number to moved lines if invoice was split
  1. I $$CKSPLIT(B,.FBILM) S DIR(0)="E" D ^DIR K DIR
  1. Q
  1. CKSPLIT(B,FBILM) ; Check for/Update split invoice
  1. ; Input
  1. ; B - ien of original batch before item moved
  1. ; FBILM( - array of invoice lines that were moved to a new batch
  1. ; passed by reference
  1. ; format FBILM(invoice number,iens)=""
  1. ; where
  1. ; invoice number = invoice number
  1. ; iens = iens of subfile 162.03 (a line item)
  1. ; Result (0 or 1)
  1. ; =0 if no lines were assigned a new invoice number
  1. ; =1 if some lines assigned a new invoice number
  1. ; May change invoice number of line items in subfile 162.03
  1. ; and inform user
  1. N FBAAIN,FBFDA,FBIENS,FBIN,FBINL,FBJ,FBK,FBL,FBM,FBRET,FBSPLT
  1. S FBRET=0
  1. ; loop thru invoice numbers in input array
  1. S FBIN="" F S FBIN=$O(FBILM(FBIN)) Q:FBIN="" D
  1. . S FBSPLT=0 ; initialize split flag to false
  1. . ; check if any unrejected invoice lines still in original batch
  1. . I $D(^FBAAC("AJ",B,FBIN)) S FBSPLT=1
  1. . ; check if any rejected invoice lines still in original batch
  1. . I 'FBSPLT S FBJ=0 F S FBJ=$O(^FBAAC("AH",B,FBJ)) Q:'FBJ D Q:FBSPLT
  1. . . S FBK=0
  1. . . F S FBK=$O(^FBAAC("AH",B,FBJ,FBK)) Q:'FBK D Q:FBSPLT
  1. . . . S FBL=0
  1. . . . F S FBL=$O(^FBAAC("AH",B,FBJ,FBK,FBL)) Q:'FBL D Q:FBSPLT
  1. . . . . S FBM=0
  1. . . . . F S FBM=$O(^FBAAC("AH",B,FBJ,FBK,FBL,FBM)) Q:'FBM D Q:FBSPLT
  1. . . . . . S FBINL=$P($G(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,0)),U,16)
  1. . . . . . I FBINL=FBIN S FBSPLT=1
  1. . Q:FBSPLT=0 ; invoice was not split
  1. . S FBRET=1
  1. . ; assign new invoice number to lines moved to the new batch
  1. . ; get a new invoice number (FBAAIN)
  1. . D GETNXI^FBAAUTL
  1. . ; loop thru the moved line items and assign the new invoice number
  1. . K FBFDA
  1. . S FBIENS="" F S FBIENS=$O(FBILM(FBIN,FBIENS)) Q:FBIENS="" D
  1. . . S FBFDA(162.03,FBIENS,14)=FBAAIN
  1. . W !!,"FYI: Invoice ",FBIN," was split since entire invoice did not move to the new batch."
  1. . W !,"Re-initiated lines are being assigned a new invoice number of ",FBAAIN,"."
  1. . ; update the file
  1. . I $D(FBFDA) D FILE^DIE("","FBFDA"),MSG^DIALOG()
  1. Q FBRET
  1. ;
  1. ;FBAARR