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

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

initial load of WorldVistAEHR
File size: 3.5 KB
RevLine 
[613]1IBECUSMU ;ALB/CPM - PHARMACY BILLING OPTION UTILITIES ; 12-DEC-96
2 ;;2.0;INTEGRATED BILLING;**52,347**;21-MAR-94;Build 24
3 ;
4 ;
5FINDC(IBIN,IBW,IBOUT) ; Find transactions which can be cancelled.
6 ; Input: IBIN -- Array of transactions, passed by reference
7 ; IBW -- 1 => Write reject statements
8 ; 2 => No writes
9 ; Output: IBOUT -- Array of transactions which can be cancelled
10 ;
11 N IBKEY,IBCHTRN,IBCHTRN5,IBCHTRN6
12 S IBKEY="" F S IBKEY=$O(IBIN(IBKEY)) Q:IBKEY="" D
13 .S IBCHTRN=IBIN(IBKEY)
14 .S IBCHTRN5=$G(^IBA(351.5,IBCHTRN,5)),IBCHTRN6=$G(^(6))
15 .;
16 .; - can cancel if original transmission was billed
17 .; (no billing rejects) without trying to cancel
18 .; (no cancel auth) or if the cancel was rejected
19 .I IBCHTRN5="",IBCHTRN6=""!($P(IBCHTRN6,"^",3)'="") S IBOUT(IBKEY)=IBCHTRN Q
20 .;
21 .; - write error messages
22 .Q:'$G(IBW)
23 .;
24 .; - billing transaction was rejected
25 .I IBCHTRN5]"" W !," The claim for ",$S($P(IBKEY,";",2):"refill #"_$P(IBKEY,";",2),1:"the original fill")," for this prescription was rejected." Q
26 .;
27 .; - transaction was cancelled
28 .W !?1,$S($P(IBKEY,";",2):"Refill #"_$P(IBKEY,";",2),1:"The original fill")," for this prescription has already been reversed."
29 ;
30 Q
31 ;
32 ;
33FINDB(IBRX,IBW,IBOUT) ; Find prescriptions which can be billed.
34 ; Input: IBRX -- Pointer to the prescription in file #52
35 ; IBW -- 1 => Write reject statements
36 ; 2 => No writes
37 ; Output: IBOUT -- Array of transactions which can be billed
38 ;
39 N IBARR,IBREF,IBKEY,IBCHTRN,IBCHTRN5,IBCHTRN6,IBREF1,LIST
40 S LIST="FINDBLIST"
41 ;
42 ; - build potential array from prescription (#52) file
43 S IBARR(IBRX_";0")=$O(^IBA(351.5,"B",IBRX_";0",0))
44 S IBREF=0
45 D RX^PSO52API($$FILE^IBRXUTL(IBRX,2),LIST,IBRX,,"R^^",,)
46 S IBREF=0 F S IBREF=$O(^TMP($J,LIST,$$FILE^IBRXUTL(IBRX,2),IBRX,"RF",IBREF)) Q:IBREF'>0 D
47 .Q:'IBREF
48 .S IBARR(IBRX_";"_IBREF)=$O(^IBA(351.5,"B",IBRX_";"_IBREF,0))
49 ;
50 K ^TMP($J,LIST)
51 S IBKEY="" F S IBKEY=$O(IBARR(IBKEY)) Q:IBKEY="" D
52 .S IBCHTRN=IBARR(IBKEY)
53 .I 'IBCHTRN S IBOUT(IBKEY)=IBCHTRN Q
54 .;
55 .S IBCHTRN5=$G(^IBA(351.5,IBCHTRN,5)),IBCHTRN6=$G(^(6))
56 .;
57 .; - can bill if original transmission was rejected,
58 .; or if that transmission was cancelled (re-submit)
59 .I IBCHTRN5]""!(IBCHTRN5=""&($P(IBCHTRN6,"^")'="")) S IBOUT(IBKEY)=IBCHTRN Q
60 .;
61 .; - write messages
62 .Q:'$G(IBW)
63 .;
64 .; - already billed (previous cancellation was rejected)
65 .I $P(IBCHTRN6,"^",3)'="" W !!," The previous cancellation for ",$S($P(IBKEY,";",2):"refill #"_$P(IBKEY,";",2),1:"the original fill")," was rejected." Q
66 .;
67 .; - never tried to cancel
68 .W !!?1,$S($P(IBKEY,";",2):"Refill #"_$P(IBKEY,";",2),1:"The original fill")," for this prescription has already been billed."
69 ;
70 Q
71 ;
72 ;
73SEL(IBARR) ; Select a fill for a prescription.
74 ; Input: IBARR -- Array of prescriptions passed by reference.
75 ; Output: IBNUM -- One of the fill numbers, or -1 (none selected)
76 ;
77 N DIR,DIRUT,DIROUT,DTOUT,DUOUT,IBSTR,IBKEY,IBRX,IBREF,IBFILL,IBNUM
78 ;
79 ; - build string for DIR(0)
80 S (IBSTR,IBKEY)="",IBNUM=-1
81 F S IBKEY=$O(IBARR(IBKEY)) Q:IBKEY="" D
82 .S IBRX=+IBKEY,IBREF=+$P(IBKEY,";",2)
83 .S IBFILL=$S(IBREF:+$$SUBFILE^IBRXUTL(IBRX,IBREF,52,.01),1:+$$FILE^IBRXUTL(IBRX,22))
84 .S IBSTR=IBSTR_IBREF_":"_$S(IBREF:"Refill #"_IBREF,1:"Original Fill")_" (filled "_$$DAT1^IBOUTL(IBFILL)_");"
85 ;
86 I IBSTR="" G SELQ
87 ;
88 S DIR("A")="Select one of the fills by number",DIR(0)="S^"_IBSTR
89 D ^DIR I $D(DUOUT)!$D(DIROUT)!$D(DTOUT) G SELQ
90 ;
91 S IBNUM=Y
92 ;
93SELQ Q IBNUM
Note: See TracBrowser for help on using the repository browser.