source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBRREL.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 4.7 KB
Line 
1IBRREL ;ALB/CPM - RELEASE MEANS TEST CHARGES 'ON HOLD' ; 03-MAR-92
2 ;;2.0;INTEGRATED BILLING;**95,153,199,347**;21-MAR-94;Build 24
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5EN ; Entry point for stand-alone 'release' option
6 I '$D(^IB("AH")) W !!,"There are no patients with charges 'on hold' at this time.",! Q
7 ;
8 D HOME^%ZIS
9 W !!,"This option is used to release Means Test charges which have been"
10 W !,"placed 'on hold.' Please enter a patient with charges 'on hold,' and these"
11 W !,"charges will be displayed and may be selected to be released to Accounts",!,"Receivable.",!
12 ;
13ASK ;
14 ;***
15 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBRREL" D T1^%ZOSV ;stop rt clock
16 ;S XRTL=$ZU(0),XRTN="IBRREL-1" D T0^%ZOSV ;start rt clock
17 ;
18 R !,"Select PATIENT NAME: ",X:DTIME G END:"^"[$E(X)
19 I $E(X,1,2)="??" D HLP1 G ASK
20 I $E(X)="?" D HLP G ASK
21 N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
22 S DIC="^DPT(",DIC(0)="QME" D ^DIC K DIC G ASK:Y<1 S DFN=+Y
23 ;
24 K IBA,PRCABN
25 S IBI=0 F IBNUM=1:1 S IBI=$O(^IB("AH",DFN,IBI)) Q:'IBI S IBA(IBNUM)=IBI
26 I '$D(IBA) W !!,"This patient does not have any charges 'on hold.'",! G ASK
27 ;
28 S IBPT=$$PT^IBEFUNC(DFN) W @IOF,$P(IBPT,"^")," Pt ID: ",$P(IBPT,"^",2),! S I="",$P(I,"-",80)="" W I K I
29 ;
30 ; - display header and list charges
31RESUME W !!,"The following IB Actions ",$S($D(PRCABN):"associated with this bill",1:"for this patient")," are ON HOLD:" D HDR
32 S IBQ=0 F IBNUM=1:1 Q:'$D(IBA(IBNUM)) D:'(IBNUM#15) Q:IBQ S IBN=IBA(IBNUM) D LST
33 . R !,"Enter RETURN to continue or '^' to stop: ",X:DTIME S:X["^"!('$T) IBQ=1 Q
34 ;
35 ; - prompt user to select IB Actions
36 S DIR(0)="LA^1:"_(IBNUM-1)_"^K:X[""."" X",DIR("A")="Select IB Action"_$E("s",IBNUM>2)_" (REF #) to release (or '^' to exit): ",DIR("?")="^D HELP^IBRREL"
37 W ! D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) G END:$D(PRCABN) D END W ! G ASK
38 ;
39 S IBRANGE=Y,IBSEQNO=1,IBDUZ=DUZ
40 ;
41 S DIR(0)="Y",DIR("A")="OK to pass "_$S($P(Y,",",2):"these charges",1:"this charge")_" to Accounts Receivable"
42 D ^DIR K DIR I 'Y!($D(DIRUT))!($D(DUOUT)) G END:$D(PRCABN) D END W ! G ASK
43 ;
44 ; - pass charges to Accounts Receivable
45 W !!,"Passing charges to Accounts Receivable...",! D HDR
46 F IBCTR=1:1 S IBNUM=$P(IBRANGE,",",IBCTR) Q:'IBNUM I $D(IBA(IBNUM)) S IBNOS=IBA(IBNUM) D ^IBR,ERR:Y<1 I Y>0 S IBN=IBA(IBNUM) D LST
47 W !!,"The charge"_$E("s",$P(IBRANGE,",",2)>0)_" listed above "_$S($P(IBRANGE,",",2):"have",1:"has")_" been passed to Accounts Receivable.",!
48 ;
49 I '$D(PRCABN) W !! S DIR(0)="E" D ^DIR K DIR D END W ! G ASK
50 ;
51END K DIC,DIRUT,DUOUT,DTOUT,IBA,IBAFY,IBARTYP,IBATYP,IBCTR,IBN,IBDA,IBDUZ
52 K IBFAC,IBI,IBIL,IBRANGE,IBNOS,IBNUM,IBPT,IBQ,IBSEQNO,IBSERV,IBSITE
53 K IBTOTL,IBTRAN,IBWHER,VA,VAERR,VADM
54 K:'$D(PRCABN) DFN
55 ;***
56 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBRREL" D T1^%ZOSV ;stop rt clock
57 Q
58 ;
59 ;
60HDR ; Display charge header.
61 N IBLINE S $P(IBLINE,"=",81)=""
62 W !,IBLINE,!," REF Action ID Bill Type",?42,"Bill #",?51,"Fr/Fl Dt",?61,"To/Rls Dt",?73,"Charge"
63 W !,IBLINE Q
64 ;
65LST ; Display individual IB Action.
66 N IBND,IBND1,IBRXN,IBRX,IBRF,IBRDT,IENS
67 S IBND=$G(^IB(IBN,0)),IBND1=$G(^IB(IBN,1)),(IBRXN,IBRX,IBRF,IBRDT)=0
68 I $P(IBND,"^",4)["52:" S IBRXN=$P($P(IBND,"^",4),":",2),IBRX=$P($P(IBND,"^",8),"-"),IBRF=$P($P(IBND,"^",4),":",3)
69 I $P(IBND,"^",4)["52:" D
70 .I IBRF>0 D
71 ..S IENS=+IBRF
72 ..S IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,+IENS,52,.01)
73 .E D
74 ..S IENS=+IBRXN
75 ..S IBRDT=$$FILE^IBRXUTL(+IENS,22)
76 W !?1,$J(IBNUM,2),?7,$J(+IBND,9)
77 W ?18,$S(IBRXN>0:"Rx #: "_IBRX_$S(IBRF>0:"("_IBRF_")",1:""),1:$P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^",8))
78 W ?42,$P($P(IBND,"^",11),"-",2)
79 W ?51,$$DAT1^IBOUTL($S(IBRXN>0:IBRDT,1:$P(IBND,"^",14)))
80 W ?61,$$DAT1^IBOUTL($S($P(IBND,"^",15)'="":($P(IBND,"^",15)),1:$P(IBND1,"^",2)))
81 W ?70,$J(+$P(IBND,"^",7),9,2)
82 Q
83 ;
84ERR ; Display error message.
85 W !?1,$J(IBNUM,2),?7,"Error encountered - a separate bulletin has been posted"
86 Q
87 ;
88HLP ; Display basic help message.
89 W !!,"Enter: the name of a patient with charges 'on hold,' or"
90 W !?10,"'??' -- to see all patients with charges 'on hold,' or"
91 W !?10,"'^' -- to quit this option.",!
92 Q
93 ;
94HLP1 ; Display all patients with charges 'on hold.'
95 N DFN,I,IBQ,PID
96 W !!,"The following patients have charges 'on hold:'"
97 S (DFN,IBQ)=0 F I=1:1 S DFN=$O(^IB("AH",DFN)) Q:'DFN D:'(I#15) Q:IBQ S PID=$$PT^IBEFUNC(DFN) W !?3,$P(PID,"^"),$J("",10),$P(PID,"^",2)
98 . R !,"Enter RETURN to continue or '^' to stop: ",X:DTIME S:X["^"!('$T) IBQ=1 Q
99 W ! Q
100 ;
101HELP ; Help for the 'Select' prompt.
102 W !!?4,"Please enter a list or range of IB Actions (i.e. 1,3,5 or 2-4,8), none"
103 W !?4,"greater than ",IBNUM-1,", to be passed to Accounts Receivable, or '^' to quit."
104 Q
105 ;
106 ;
107AR ; Accounts Receivable entry point to release charges.
108 ; Input: PRCABN -- ien of Bill/Accounts Receivable
109 Q:$D(PRCABN)[0 Q:'$$IB^IBRUTL(PRCABN,1) G RESUME
Note: See TracBrowser for help on using the repository browser.