source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJTU2.m@ 1036

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

initial load of WorldVistAEHR
File size: 3.2 KB
Line 
1IBJTU2 ;ALB/ARH - TPI UTILITIES ;6/6/03 1:05pm
2 ;;2.0;INTEGRATED BILLING;**39,106,199,211,276**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5PAT() ; select patient, only allows patient's that have bills - returns DFN^NAME if patient selected, 0 otherwise
6 N X,Y,DFN,DTOUT,DUOUT,DA
7 N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
8 S DFN=0,DIC(0)="AEQM",DIC="^DPT(",DIC("S")="I $D(^DGCR(399,""C"",Y))" D ^DIC K DIC I Y'<1 S DFN=Y
9 Q DFN
10 ;
11BILL() ; select bill, returns bill IFN^BILL NUMBER or 0 if none selected
12 N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
13 N X,Y,DTOUT,DUOUT,DA,IBY S IBY=0,DIC="^DGCR(399,",DIC(0)="AEMQ" D ^DIC K DIC I Y'<1 S IBY=Y
14 Q IBY
15 ;
16PB() ; select either a patient name (must have a bill) or bill number
17 ; if patient chosen: returns "1^"_DFN, if bill chosen: returns "2^"_IBIFN, 0 otherwise
18 N IBX,IBY,DIC,DTOUT,DUOUT,DA,X,Y,DPTNOFZY,IBSTR
19 S IBY=0
20 ;
21PB1 R !!,"Enter BILL NUMBER or PATIENT NAME: ",IBX:DTIME I IBX["^"!(IBX="") G PBQ
22 ;
23 I $E(IBX)="?" D G PB1
24 . W !
25 . W !," Enter one of following: Patient Name, Bill Number,"
26 . W !," ECME Number or Prescription Number."
27 . W !," You may also use prefixes: 'E.' for ECME# or 'R.' for Prescription."
28 . W !
29 ;
30 ; search for patient name
31 I IBX?1A4N!(IBX?2A.AP)!(IBX?2.A1",".AP)!(IBX?1A1P.AP) D I IBY G PBQ
32 . S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
33 . S DIC="^DPT(",DIC(0)="EQM",DIC("S")="I $D(^DGCR(399,""C"",Y))",X=IBX D ^DIC K DIC I Y'<1 S IBY="1^"_+Y
34 ;
35 ; search for bill number
36 I (IBX?1A1.7AN)!(IBX?3N1"-"1A1.7AN)!(IBX?1"`"1.15N)!(IBX=" ") D I IBY G PBQ
37 . S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
38 . S IBSTR=IBX
39 . I $L(IBSTR,"-")=2,$P(IBSTR,"-")?3N S IBSTR=$P(IBX,"-",2,255)
40 . S DIC="^DGCR(399,",DIC(0)="EQ",X=IBSTR D ^DIC K DIC I Y'<1 S IBY="2^"_+Y
41 ;
42 ; search for ECME number REC^IBRFN()
43 S IBSTR=IBX
44 I IBSTR?1.7N S IBSTR="E."_IBSTR
45 I IBSTR?1"E."1.7N S Y=$$REC^IBRFN(IBSTR) I Y>0 S IBY="2^"_+Y G PBQ
46 ;
47 ; search for RX number REC^IBRFN()
48 S IBSTR=IBX
49 I IBSTR?1N1.10AN S IBSTR="R."_IBSTR
50 I IBSTR?1"R."1N1.10AN S Y=$$REC^IBRFN(IBSTR) I Y>0 S IBY="2^"_+Y G PBQ
51 ;
52 W "??"
53 G PB1
54PBQ Q IBY
55 ;
56RCANC(IBIFN,ARR,WDTH) ; if bill cancelled returns ARR = IBIFN ^ PTR TO 200 ^ INITIALS OF WHO CANCELLED IN IB
57 ; ARR(X) = REASON CANCELLED with line width passed in
58 N X,DIWL,DIWR,DIWF,IBDS,IBCNT,IBI,IBD K ARR
59 S ARR=0,IBIFN=+$G(IBIFN),IBDS=$G(^DGCR(399,IBIFN,"S"))
60 S X=$P(IBDS,U,18) G:'X RCANCQ
61 S ARR=IBIFN_U_X_U_$P($G(^VA(200,+X,0)),U,2)
62 S X=$P(IBDS,U,19) G:X="" RCANCQ
63 S DIWL=1,DIWR=$G(WDTH),DIWF="" D ^DIWP
64 S (IBCNT,IBI)=0,DIWL=1 F S IBI=$O(^UTILITY($J,"W",DIWL,IBI)) Q:'IBI D
65 . S IBD=$G(^UTILITY($J,"W",DIWL,IBI,0)) I IBD'="" S IBCNT=IBCNT+1,ARR(IBCNT)=IBD
66 K ^UTILITY($J,"W")
67RCANCQ Q
68 ;
69DR(DB,DE) ; get a date range from the user, DB is default begin date (FM), DE is default end date
70 ; returns "begin dt ^ end dt" in FM format, or "" if two valid dates are not entered
71 N IBY,IBX,%DT,X,Y S (IBX,IBY)="" I $G(DB)?7N S %DT("B")=$$FMTE^XLFDT(DB,2)
72 S %DT="AEX",%DT("A")="Start Date: " D ^%DT K %DT G:Y<0 DRQ S IBX=Y
73 S %DT(0)=IBX,%DT("B")=$$FMTE^XLFDT($S(IBX>$G(DE):IBX,1:DE),2)
74 S %DT="AEX",%DT("A")="End Date: " D ^%DT K %DT G:Y<0 DRQ S IBY=IBX_U_Y
75DRQ Q IBY
Note: See TracBrowser for help on using the repository browser.