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

FBAAPIE.m

Go to the documentation of this file.
FBAAPIE ;AISC/GRR - ENTER FEE PHARMACY INVOICE ;9/25/2014
 ;;3.5;FEE BASIS;**61,124,123,154**;JAN 30, 1995;Build 12
 ;;Per VA Directive 6402, this routine should not be modified.
 D SITEP^FBAAUTL W:FBPOP !!,*7,"Fee site parameters must be initialized!!" Q:FBPOP  S FBMDF=$P(FBSITE(0),"^",10),FBAAPTC=$S($D(FBAAPTC):FBAAPTC,1:"V")
 N FBIA,FBDODINV
RD1 W ! S DIR("A")="Are you sure you want to enter a new invoice",DIR("B")="Yes",DIR(0)="Y" D ^DIR K DIR G Q^FBAAPIE1:$D(DIRUT),RDM^FBAAPIE1:'Y
ENTER S (LCNT,TAC,FBINTOT)=0,STAT(0)="",FBAAOUT=1 K FBTOUT
 D GETNXI^FBAAUTL S X=FBAAIN
 S DLAYGO=162.1,DIC="^FBAA(162.1,",DIC(0)="LQ" D ^DIC K DLAYGO G:Y<0 PROB^FBAAPIE1 W !!,"Invoice # assigned is: ",X S IN=X,DA(1)=IN
RDV I '$D(FB583) W !! S DLAYGO=161.2,(DIE,DIC)="^FBAAV(",DIC(0)="AEQLM" D ^DIC K DLAYGO G CHK:Y<0 S DA=+Y D NEW^FBAAVD:$P(Y,"^",3)=1
 I $D(FB583) S DA=FBVEN
 I $D(^FBAAV(DA,0)),$P($G(^("ADEL")),"^")="Y" W !!,"Vendor is flagged for Austin deletion!" G RDV:'$D(FB583),Q^FBAAPIE1
 D EN1^FBAAVD:$P(FBSITE(0),"^",12)="Y" S VIN=DA
RDV1 I $D(^XUSEC("FBAA ESTABLISH VENDOR",DUZ)) W ! S DIR("A")="Want to edit Vendor data",DIR("B")="No",DIR(0)="Y" D ^DIR K DIR G CHK:$D(DIRUT) D:Y EDITV^FBAAVD S VIN=DA
 S FBAR(DA)="" D ^FBAACO4
 ;
 ; FB*3.5*123 - check for IPAC agreement for Federal Vendor
 S FBIA=$$IPAC^FBAAMP($G(VIN)) I FBIA=-1 G CHK
 ;
 W !! S %DT="AEQXP",%DT(0)=-DT,%DT("A")="Date Correct Invoice Received: " D ^%DT K %DT(0),%DT("A") G CHK:Y<0 S INVDATE=Y
 W !! S %DT="AEQXP",%DT(0)=-INVDATE,%DT("A")="Vendor Invoice Date:  " D ^%DT K %DT(0),%DT("A") G CHK:Y<0 S FBVINVDT=Y
 ; if U/C then get FPPS Claim ID else ask user
 I $D(FB583) S FBFPPSC=$P($G(^FB583(FB583,5)),U) W !,"FPPS CLAIM ID: ",$S(FBFPPSC="":"N/A",1:FBFPPSC)
 E  S FBFPPSC=$$FPPSC^FBUTL5() I FBFPPSC=-1 K FBFPPSC G CHK
 S (DIE,DIC)="^FBAA(162.1,",DA=IN
 S DR="1////^S X=INVDATE;1.5////^S X=DT;2////^S X=DUZ;3////^S X=VIN;5////^S X=1;12////^S X=FBVINVDT;13///^S X=FBFPPSC"
 I $G(FBIA) S DR=DR_";14////^S X=FBIA"    ; FB*3.5*123 file IPAC agreement ptr if it exists
 D ^DIE
 I '$D(^FBAA(162.1,IN,"RX",0)) S ^FBAA(162.1,IN,"RX",0)="^162.11A^^"
RDP S FBPHARM=1 W:FBINTOT>0 !,?15,"Pharmacy Invoice #: "_IN_"  Totals: $ "_$J(FBINTOT,1,2)
 ; if EDI then ask FPPS Line Item
 I FBFPPSC]"" W !!! S FBFPPSL=$$FPPSL^FBUTL5() I FBFPPSL=-1 K FBFPPSL G CHK
 D ^FBAASAP K FBPHARM I 'DFN K DFN G CHK
 ;
 I '$D(FB583),'$$UOKPAY^FBUTL9(DFN,FTP) D  G RDP
 . W !!,"You cannot process a payment associated with authorization ",DFN,"-",FTP
 . W !,"due to separation of duties."
 ;
 I FBTT=1 S FBMST="Y",FBTTYPE="A",FBFDC="",FBD1=FTP D ENT^FBAAAUT
 D HOME^%ZIS,FBPH^FBAAUTL2 I $D(DIRUT),$D(FB583) G CHK
RDD W !! S %DT(0)=-DT,%DT="AEXP",%DT("A")="DATE PRESCRIPTION FILLED: " D ^%DT K %DT G:X["^"!(X="") RDP G RDD:Y<0 S DATEF=Y
 I DATEF<FBAABDT!(DATEF>FBAAEDT) W !!,*7,"Date Prescription Filled is ",$S(DATEF<FBAABDT:" prior to ",1:"later than "),"authorization period!!" G RDD
 I INVDATE]"",DATEF>INVDATE D  G RDD
 .N SHOINVDT S SHOINVDT=$E(INVDATE,4,5)_"/"_$E(INVDATE,6,7)_"/"_$E(INVDATE,2,3)
 .W !!,*7,?5,"*** Date Prescription Filled cannot be later than",!?8," Invoice Received Date (",SHOINVDT,") !!!"
 ;
 ; FB*3.5*123 - for IPAC capture the DoD Invoice number
 I $G(FBIA),'$$IPACINV^FBAAMP(.FBDODINV) G RDD
 I '$G(FBIA) S FBDODINV=""
 ;
 I '$D(^FBAA(162.1,IN,"RX",0)) S ^FBAA(162.1,IN,"RX",0)="^162.11A^^"
RDRX S DIR(0)="162.11,.01",DIR("A")="Select PRESCRIPTION NUMBER" D ^DIR K DIR G CHK:Y="^"!(Y="") S PSRX=Y,AC=0
 I $D(^FBAA(162.1,IN,"RX","B",PSRX)) G RX2^FBAAPIE1
 D CHK2^FBAAPIE1 I FBJ]"" K FBJ G CHKK^FBAAPIE1
RXADD K DA S DLAYGO=162.1,DA(1)=IN,DIC="^FBAA(162.1,"_IN_",""RX"",",DIC(0)="EQL",X=""""_PSRX_"""" D ^DIC K DLAYGO G:Y<0 RDRX S FBDA=+Y
 S DIE="^FBAA(162.1,",DA=IN,DR="[FB ADD RX]" D ^DIE I $D(DTOUT)!('$G(FBUP)) G DELRX
 S LCNT=LCNT+1,TAC=TAC+AC K FBUP
RDDER W !!,*7,"Prescription referred to Pharmacy Service for determination.",! S X="Y"
 S STAT(1)="" G RDP:'$D(FB583),Q^FBAAPIE1
 S $P(^FBAA(162.1,IN,"RX",DA,2),"^")="P",^FBAA(162.1,"AH","P",IN,DA)="",$P(^FBAA(162.1,IN,0),"^",10)="P"
 S DA(1)=IN,DIE=DIC
HERE S:$D(FBAP) FBINTOT=FBINTOT+FBAP S:$D(DTOUT) FBTOUT="" G OVR:$D(DTOUT),RDD
CHK I LCNT'>0 W !!,"Since you didn't enter any line items",!,"Invoice # ",IN," has been Deleted!!",*7 D KILL G Q^FBAAPIE1:$D(FBTOUT),MORE:'$D(FB583),Q^FBAAPIE1
OVR K DTOUT,DR,DQ,DG
 K STAT(2)
 S (DIE,DIC)="^FBAA(162.1,",DA=IN,STAT=$O(STAT(0)),DR="5////^S X=STAT;6///^S X=TAC;7///^S X=FBINTOT;8///^S X=LCNT" D ^DIE G:$D(FBTOUT) Q^FBAAPIE1 W !!,"Invoice No.: ",IN," Completed!" W:FBINTOT>0 ?45,"Invoice Total: $ ",$J(FBINTOT,1,2)
MORE K STAT,FBHX W ! S DIR("A")="Want to enter another Invoice",DIR("B")="No",DIR(0)="Y" D ^DIR K DIR G Q^FBAAPIE1:$D(DIRUT)!('Y),ENTER
 Q
KILL S DIK="^FBAA(162.1,",DA=IN D ^DIK K DIK Q
DELRX S DIK="^FBAA(162.1,"_DA(1)_",""RX"",",DA=FBDA D ^DIK K DTOUT,DQ,DR,DG S FBTOUT="" W !,"Incomplete prescription entry.  Deleted.",! G CHK