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

FBAAVP.m

Go to the documentation of this file.
  1. FBAAVP ;AISC/DMK - VOID & CANCEL VOIDED MEDICAL PAYMENT ;5/15/14 17:36
  1. ;;3.5;FEE BASIS;**4,69,154**;JAN 30, 1995;Build 12
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;Variable 'FBVOID' is set if cancelling a voided payment.
  1. D DT^DICRW
  1. RDP K ^TMP($J) W !! S DIC="^FBAAC(",DIC(0)="AEQM",DIC("A")="Select Patient: " D ^DIC K DIC("A") G Q:X="^"!(X=""),RDP:Y<0 S DFN=+Y
  1. S:'$D(^FBAAC(DFN,1,0)) ^FBAAC(DFN,1,0)="^162.01P^0^0"
  1. RDV W !! S DIC="^FBAAV(",DIC(0)="AEQM",DA(1)=DFN D ^DIC G RDP:X="^"!(X=""),RDV:Y<0 S DA=+Y G:'$D(^FBAAC(DFN,DA,"AD")) NOCL^FBAAVP0 D EN1
  1. I CNT'>0 G NVOID^FBAAVP0
  1. D CPAY G Q
  1. EN1 S Q="",$P(Q,"-",80)="-",CNT=0
  1. S IOP=$S($D(ION):ION,1:"HOME") D ^%ZIS K IOP D HED
  1. F D=0:0 S D=$O(^FBAAC(DFN,DA,"AD",D)) Q:D'>0 F B=0:0 S B=$O(^FBAAC(DFN,DA,"AD",D,B)) Q:B'>0 F K=0:0 S K=$O(^FBAAC(DFN,1,DA,1,B,1,K)) Q:K'>0 S L=^(K,0) Q:$D(^FBAAC(DFN,1,DA,1,B,1,K,"FBREJ")) D EN2
  1. Q
  1. EN2 S FBAAPD=$P(L,"^",14),ZS=$P(L,"^",20),FD=$P(L,"^",6),FBON=$P(L,"^",10),V=$P(L,"^",21) I FD]""&$S($D(FBVOID):(V="VP"),1:(V="")) D WRT
  1. Q
  1. WRT N FBFPPSC S FBFPPSC=$P($G(^FBAAC(DFN,1,DA,1,B,1,K,3)),U,1)
  1. S FBDT=$P(^FBAAC(DFN,1,DA,1,B,0),"^"),FBAADT=$E(FBDT,4,5)_"/"_$E(FBDT,6,7)_"/"_$E(FBDT,2,3),B1=$P(L,"^",8),B2=$S(B1="":"",$D(^FBAA(161.7,B1,0)):$P(^FBAA(161.7,B1,0),"^"),1:""),CNT=CNT+1,FBVD=DA,FBSD=B,FBSV=K
  1. D FBCKO^FBAACCB2(DFN,FBVD,FBSD,FBSV)
  1. S FBAAPD=$S(FBAAPD]"":$E(FBAAPD,4,5)_"/"_$E(FBAAPD,6,7)_"/"_$E(FBAAPD,2,3),1:"")
  1. S A1=$P(L,"^",2)+.0001,A2=$P(L,"^",3)+.0001,A1=$P(A1,".")_"."_$E($P(A1,".",2),1,2),A2=$P(A2,".")_"."_$E($P(A2,".",2),1,2),FBIN=$P(L,"^",16)
  1. S FBAACPT=$$CPT^FBAAUTL4($P(L,"^"))
  1. S FBMODLE=$$MODL^FBAAUTL4("^FBAAC("_DFN_",1,"_DA_",1,"_B_",1,"_K_",""M"")","E")
  1. W !,CNT_") ",$S(ZS="R":"*",1:""),$S(V="VP":"#",1:""),?3,FBAADT,?14,FBAACPT_$S($G(FBMODLE)]"":"-"_$P(FBMODLE,","),1:""),?23,"$",$J(A1,8),?34,"$",$J(A2,8),?49,FBIN,?60,B2,?68,FBAAPD
  1. I $P($G(FBMODLE),",",2)]"" D ;Q:FBAAOUT
  1. . N FBI
  1. . F FBI=2:1 S FBMOD=$P(FBMODLE,",",FBI) Q:FBMOD="" D ;Q:FBAAOUT
  1. . . ;I $Y+4>IOSL D Q:FBAAOUT
  1. . . ;. I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR I 'Y S FBAAOUT=1 Q
  1. . . ;. D HED W !,CNT,") (continued)"
  1. . . W !,?19,"-",FBMOD
  1. I FBFPPSC]"" W !,?4,"FPPS Claim ID: ",FBFPPSC
  1. D PMNT^FBAACCB2
  1. I $D(^FBAAC(DFN,1,DA,1,B,1,K,"R")),^("R")]"" W !?3,"Reason:",!?10,^("R"),!
  1. S ^TMP($J,CNT)=FBAADT_"^"_FBAACPT_$S($G(FBMODLE)]"":"-"_FBMODLE,1:"")_"^"_$J(A1,8)_"^"_$J(A2,8)_"^"_FBFPPSC_"^"_FBIN_"^"_B2_"^"_FBAAPD_"^"_FBSD_"^"_FBSV_"^"_FD_"^"_A2_"^"_FBON Q
  1. Q
  1. HED W @IOF,"Patient Name: ",$P(^DPT(DFN,0),"^"),?50,"Pt.ID ",$$SSN^FBAAUTL(DFN),!!,?2,"VENDOR: ",$P(^FBAAV(DA,0),"^"),!,?10,"('*' Reimb. to Patient '#' Voided Payment)"
  1. W !," SVC DATE",?11,"CPT-MOD",?20,"AMT CLAIMED",?35,"AMT PAID",?47,"INVOICE #",?57,"BATCH #",?66,"DATE PAID",!,Q,!
  1. Q
  1. Q K DIC,DIE,DA,DF,DA(1),^TMP($J),A,A1,A2,B,B1,B2,C,CNT,D,D0,D1,D2,D3,DI,DR,DFN,DIYS,FBAACB,FBAACPT,FBAADT,FBAAPD,FBX,DIR,FBDT,FBIN,FBON,FBSD,FBSV,FD,FBVD,FBVOID,I,K,L,ON,POP,P3,P4,Q,V,X,Y,VP,VAL,ZS,Z,ZZ,FBSSN,DIRUT,FBMOD,FBMODLE
  1. Q
  1. CPAY W !!,"Which payment item(s) would you like to ",$S($D(FBVOID):"Cancel the void on",1:"Void")," ? " S DIR(0)="L^1:"_CNT D ^DIR
  1. G RDV:$D(DIRUT) S FBX=Y D HED
  1. F A=1:1:CNT S X=$P(FBX,",",A) Q:X="" S Y(0)=^TMP($J,X),FBSD=$P(Y(0),"^",9),FBSV=$P(Y(0),"^",10),FD=$P(Y(0),"^",11),A2=$P(Y(0),"^",12),FBON=$P(Y(0),"^",13),^TMP($J,"VOID",X)=DFN_"^"_FBVD_"^"_FBSD_"^"_FBSV_"^"_FD_"^"_A2_"^"_FBON D PRT2
  1. VERF S DIR(0)="Y",DIR("A")="Are you sure you want to "_$S($D(FBVOID):"Cancel the void on ",1:"Void ")_"the payment(s)",DIR("B")="NO" D ^DIR K DIR G RDP:$D(DIRUT)!'Y
  1. F I=0:0 S I=$O(^TMP($J,"VOID",I)) Q:I'>0 S Y(0)=^(I),DFN=$P(Y(0),"^"),FBVD=$P(Y(0),"^",2),FBSD=$P(Y(0),"^",3),FBSV=$P(Y(0),"^",4),A2=$P(Y(0),"^",6),FBON=$P(Y(0),"^",7) D SETN,^FBAAVP0 W !,?5,".... Done.",!
  1. K FBVR Q
  1. SETN S DA=FBSV,VP=$S($D(FBVOID):"",1:"VOID")
  1. I $D(FBVOID) S DR="24///@;24.5///@;25///@"
  1. I '$D(FBVOID) S DR="24///^S X=VP;25////^S X=DUZ"_$S($D(FBVR):";24.5////^S X=FBVR",1:";24.5R;S FBVR=X")
  1. S DIE="^FBAAC("_DFN_",1,"_FBVD_",1,"_FBSD_",1,",DIDEL=162 D ^DIE K DIDEL Q
  1. PRT2 D FBCKO^FBAACCB2(DFN,FBVD,FBSD,FBSV)
  1. W !,$P(Y(0),"^",1),?14,$P($P(Y(0),"^",2),","),?23,$P(Y(0),"^",3),?34,$P(Y(0),"^",4),?49,$P(Y(0),"^",6),?62,$P(Y(0),"^",7),?68,$P(Y(0),"^",8)
  1. I $P($P(Y(0),U,2),",",2)]"" D ;Q:FBAAOUT
  1. . N FBI
  1. . F FBI=2:1 S FBMOD=$P($P(Y(0),U,2),",",FBI) Q:FBMOD="" D ;Q:FBAAOUT
  1. . . ;I $Y+4>IOSL D Q:FBAAOUT
  1. . . ;. I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR I 'Y S FBAAOUT=1 Q
  1. . . ;. D HED W !,CNT,") (continued)"
  1. . . W !,?19,"-",FBMOD
  1. I $P(Y(0),U,5)]"" W !,?4,"FPPS Claim ID: ",$P(Y(0),U,5)
  1. W !
  1. D PMNT^FBAACCB2
  1. Q