source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBAACO1.m@ 1147

Last change on this file since 1147 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.6 KB
Line 
1FBAACO1 ;AISC/GRR-ENTER PAYMENT CONTINUED ;7/17/2003
2 ;;3.5;FEE BASIS;**4,61,77**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4SVCPR ;set up service provided multiple
5 I '$D(^FBAAC(DFN,1,FBV,1,FBSDI,1,0)) S ^FBAAC(DFN,1,FBV,1,FBSDI,1,0)="^162.03A^0^0"
6 W ! S DLAYGO=162,DIC="^FBAAC("_DFN_",1,"_FBV_",1,"_FBSDI_",1,",DIC(0)=$S($G(FBCNP):"QL",1:"EQL"),X=""""_FBX_"""",DA(3)=DFN,DA(2)=FBV,DA(1)=FBSDI
7 D
8 . N ICPTVDT S ICPTVDT=$G(FBAADT) D ^DIC
9 K DIC,DLAYGO,DA I Y<0 S FBAAOUT=1 Q
10 S (FBAACPI,DA)=+Y
11 ;
12 ; update zip code and anesthesia time
13 S DIE="^FBAAC("_DFN_",1,"_FBV_",1,"_FBSDI_",1,"
14 K DA S DA(3)=DFN,DA(2)=FBV,DA(1)=FBSDI,DA=FBAACPI
15 S DR="42////^S X=$G(FBZIP);43////^S X=$G(FBTIME)"
16 D ^DIE K DIE,DA,DR
17 ;
18 ; create CPT MODIFIER entries from data in array FBMODA
19 D REPMOD^FBAAUTL4(DFN,FBV,FBSDI,FBAACPI)
20 ;
21 Q
22 ;
23PPT(FBDEF) ;establishes prompt pay type for entry
24 ;fbaamm=ppt if 1 ask for each line item; if 0 don't ask
25 ;fbaamm1=the ppt for each line item
26 ;FBDEF=(optional) default for DIR prompt: =1 for yes, otherwise no
27 N Y I FBAAMM="" S FBAAMM1="" Q
28 I FBAAMM=1 F D Q:Y]""
29 . S DIR(0)="Y",DIR("A")="Is this line item for a contracted service"
30 . S DIR("B")=$S($G(FBDEF)=1:"Yes",1:"No")
31 . S DIR("?")="Answering no indicates that interest will not be paid for this line item."
32 . D ^DIR K DIR I $D(DIRUT) W !,$C(7),"Required Response!" S Y=""
33 S FBAAMM1=$S(Y=1:1,1:"")
34 Q
35Q K FBAADT,FBX,FBAACP W:FBINTOT>0 !!,"Invoice: "_FBAAIN_" Totals $ "_$J(FBINTOT,1,2) G Q^FBAACO:$D(FB583),1^FBAACO:'$D(FBCHCO) Q
36 ;
37POS ; prompt for place of service
38 ; output
39 ; FBHCFA(30) = place of service (internal)
40 N Y
41 S FBHCFA(30)=""
42 S DIR(0)="P^353.1:EMZ"
43 D ^DIR K DIR I $D(DIRUT) Q
44 S FBHCFA(30)=$P(Y,U)
45 Q
46 ;
47GETVEN ;select vendor from vendor file
48 W !! S DLAYGO=161.2,DIC="^FBAAV(",DIC(0)="AEQLM" D ^DIC K DLAYGO I X="^"!(X="") S FBAAOUT=1 Q
49 ;if new vendor, call in to new vendor setup routine
50 G GETVEN:Y<0 S DA=+Y,DIE=DIC D:$P(Y,"^",3)=1 NEW^FBAAVD K DIE,DIC,DR,X,DLAYGO
51GETVEN1 I $D(FB583) S DA=FBVEN
52 I $D(^FBAAV(DA,0)),$P($G(^("ADEL")),U)="Y" W !!,$C(7),"Vendor has been flagged for Austin deletion!" G GETVEN:'$D(FB583) S FBAAOUT=1 Q
53 D:$P(FBSITE(0),"^",11)="Y" EN1^FBAAVD
54GETVEN2 I $P(FBSITE(0),"^",11)="Y",$D(^XUSEC("FBAA ESTABLISH VENDOR",DUZ)) S DIR(0)="Y",DIR("A")="Want to Edit data",DIR("B")="NO" D ^DIR K DIR S:$D(DIRUT) FBAAOUT=1 Q:$D(DIRUT) D:Y EDITV^FBAAVD
55 I $P(FBSITE(0),"^",11)'="Y"!('$D(^XUSEC("FBAA ESTABLISH VENDOR",DUZ))) S DIR(0)="E" D ^DIR K DIR I $D(DIRUT) S FBAAOUT=1 Q
56 S FBV=DA,FBAR(DA)="" D ^FBAACO4
57 Q
58 ;
59GETINV ;assign invoice number or select existing invoice number
60 K FBAAOUT S FBINTOT=0 S DIR(0)="Y",DIR("A")="Want a new Invoice number assigned",DIR("B")="YES" D ^DIR K DIR I $D(DIRUT) S FBAAOUT=1 Q
61 I Y D GETNXI^FBAAUTL W !!,"Invoice # ",FBAAIN," assigned to this Invoice" Q
62GETINV1 ;selects existing invoice if user does not choose to assign new number
63 S DIR(0)="N",DIR("A")="Select Invoice number",DIR("?")="Select one of the previously entered Invoice #'s" D ^DIR K DIR I $D(DIRUT)!(X="") G GETINV:'$G(FB583) S FBAAOUT=1 Q
64 D CHK1^FBAACO4 G GETINV1:'$G(FBAACK1) K FBAACK1
65 I '$D(^FBAAC("AJ",FBAABE,X)) D G GETINV1
66 . W !,$C(7),"Only previously entered invoices in the same batch may be selected!"
67 S FBAAIN=X D CALC^FBAACO3 W:FBINTOT>0 ?33,"Current Total: $ "_$J(FBINTOT,1,2)
68 Q
69 ;
70GETINDT ;get invoice dates
71 ;input requires FBAABDT (authorization from date)
72 K FBAAOUT W !,"Enter Date Correct Invoice Received or Last Date of Service" S %DT("A")="(whichever is later): " S:$G(FBAAID) %DT("B")=$$DATX^FBAAUTL(FBAAID) I $G(FBCNH) S %DT(0)=$G(FBENDDT)
73 S %DT="AEXP" D ^%DT K %DT I X="^"!(X="") S FBAAOUT=1 Q
74 S FBAAID=Y I '$G(FBCNP) I FBAAID<FBAABDT W !!,$C(7),"Invoice date is earlier than Patient's Authorization date!!" K FBAAID G GETINDT
75GETIND1 W ! S %DT("A")="Enter Vendor Invoice Date: ",%DT="AEXP" S:$G(FBAAVID) %DT("B")=$$DATX^FBAAUTL(FBAAVID) D ^%DT K %DT G GETINDT:X="" I X="^" S FBAAOUT=1 Q
76 S FBAAVID=Y I FBAAVID>FBAAID W !!,$C(7),"Vendor's invoice date is later than the date you received it!!" K FBAAVID G GETIND1
77 Q
78 ;
79DISPINV ;display invoice totals
80 ;required inputs FBAADT (auth dt),DFN
81 S H=$E(FBAADT,1,5)_"00",R=9999999.9999-H,S=$E(FBAADT,1,5)_31,S=9999999.9999-S,G=+$E(FBAADT,4,5)_+$E(FBAADT,2,3) D CKMAX^FBAACO3
82 S FBTPD=0 I $D(^FBAAC(DFN,3,"AB",FBAADT)) S FBZX=$O(^FBAAC(DFN,3,"AB",FBAADT,0)) I $D(^FBAAC(DFN,3,FBZX,0)) W !!,"$ ",$P(^(0),"^",3)," for travel already entered for this date of service" S FBTPD=1
83 W:'$D(FBCHCO) !!,"Total already paid on ID Card for month: $ ",A," Maximum allowed: $ ",$P(FBSITE(1),"^",9),!,"Total already paid on All/Other for month: $ ",FBAOT
84 Q
Note: See TracBrowser for help on using the repository browser.