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

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

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1IBOCHK ;ALB/AAS - INTEGRATED BILLING - RX COPAY LINK CHECK ; 2-APR-91
2 ;;2.0;INTEGRATED BILLING;**347**; 21-MAR-94;Build 24
3 ;
4 ; -loop through range of IB reference numbers and verify
5 ; soft link exists and has link back to IB.
6 ;
7% ;
8 ;***
9 ;S XRTL=$ZU(0),XRTN="IBOCHK-1" D T0^%ZOSV ;start rt clock
10 ;
11 D HOME^%ZIS W @IOF,?24,"Verify IB - Pharmacy Co-Pay links",!!
12 ;
13ST S DIC="^IB(",DIC(0)="AEQMN",DIC("A")="START WITH REFERENCE NUMBER:",DIC("B")="" D ^DIC K DIC G:+Y<1 END S IBSTART=$P(Y,"^",2)
14 ;
15TO S DIC="^IB(",DIC(0)="AEQMN",DIC("A")="GO TO REFERENCE NUMBER: ",DIC("B")="" D ^DIC K DIC G:+Y<1 END S IBEND=$P(Y,"^",2)
16 I IBSTART>IBEND W *7,!!,"End must not be less than beginning number",! G ST
17 ;
18DEV W !!,"*** Margin width of this output is 132 ***"
19 W ! S %ZIS="QM",%ZIS("A")="Output Device: " D ^%ZIS G:POP END
20 I $D(IO("Q")) S ZTRTN="DQ^IBOCHK",ZTDESC="IB Check Pharmacy Links",ZTSAVE("IB*")="" D ^%ZTLOAD K IO("Q") W ! G END
21 ;
22 U IO
23 ;***
24 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOCHK" D T1^%ZOSV ;stop rt clock
25 ;
26DQ ; -entry point from queing
27 ;S XRTL=$ZU(0),XRTN="IBOCHK-2" D T0^%ZOSV ;start rt clock
28 ;
29 S (IBCNT,IBECNT)=0,IBPAG=0,IBQUIT=0 S Y=DT D D^DIQ S IBHDT=Y D HDR
30 S IBRNUM=IBSTART-1
31 F S IBRNUM=$O(^IB("B",IBRNUM)) Q:'IBRNUM!(IBRNUM>IBEND)!(IBQUIT) S IBN="" F S IBN=$O(^IB("B",IBRNUM,IBN)) Q:'IBN!(IBQUIT) D CHK
32 G END
33 ;
34CHK S IBCNT=IBCNT+1
35 N DFN,IBNODE
36 I '$D(^IB(IBN,0))!('$D(^IB(IBN,1))) S IBOERR=1,IBND=IBN G LINE ;xref to no entry
37 S IBND=$S($D(^IB(IBN,0)):^(0),1:"")
38 S IBSL=$P(^IB(IBN,0),"^",4) I 'IBSL S IBOERR=2 G LINE ;no softlink
39 I +IBSL'=52 Q ;not a pharmacy rx entry
40 S IBRXN=$P($P(IBSL,";"),":",2),IBRXN1=$P($P(IBSL,";",2),":",2)
41 S DFN=$P(^IB(IBN,0),"^",2)
42 I $$FILE^IBRXUTL(IBRXN,.01)="" S IBOERR=3 G LINE ;rx deleted
43 S IBNODE=$$IBND^IBRXUTL(DFN,IBRXN)
44 I IBNODE'["^" S IBOERR=4 G LINE ;IB node missing
45 I +IBNODE,'$P(IBNODE,"^",2) S IBOERR=5 G LINE ;pointer back to IB missing
46 Q:'IBRXN1
47 I +$$SUBFILE^IBRXUTL(IBRXN,IBRXN1,52,.01)=0 S IBOERR=6 G LINE ;refill deleted
48 I $$IBNDFL^IBRXUTL(DFN,IBRXN,IBRXN1)'["^" S IBOERR=7 G LINE ;ib node on refill missing
49 I +$$IBNDFL^IBRXUTL(DFN,IBRXN,IBRXN1)=0 S IBOERR=8 G LINE ;no data on node
50 Q ;pharmacy links okay.
51 ;
52HDR ;
53 S IBPAG=IBPAG+1
54 W:$E(IOST,1,2)["C-"!(IBPAG>1) @IOF
55 W "Verify Integrated Billing links to Pharmacy",?IOM-22,IBHDT," Page:",IBPAG
56 W !,"Verify IB Reference Number ",IBSTART," to ",IBEND
57 W !,"REF. NO.",?12,"PATIENT",?34,"SSN",?40,"RX#",?50,"REFILL",?58,"IB LINK",?80,"CHARGE ID",?91,"TRANS",?97,"ERROR MESSAGE"
58 S $P(IBLINE,"-",IOM)="" W !,IBLINE K IBLINE
59 Q
60LINE ;
61 I $Y>(IOSL-5) D PAUSE^IBOUTL Q:IBQUIT D HDR
62 S IBECNT=IBECNT+1
63 W !,$P(IBND,"^") S DFN=$P(IBND,"^",2)
64 I $D(^DPT(+DFN,0)) D PID^VADPT W ?12,$E($P(^DPT(DFN,0),"^"),1,20),?34,VA("BID"),?40,$P($P(IBND,"^",8),"-"),?50,$P($P(IBSL,";",2),":",2),?58,IBSL,?80,$P(IBND,"^",11),?91,$P(IBND,"^",12)
65 W ?97,$P($T(IBOERR+IBOERR),";;",2,99)
66 Q
67 ;
68END ;
69 ;***
70 I $D(XRT0) S:'$D(XRTN) XRTN="IBOCHK" D T1^%ZOSV ;stop rt clock
71 ;
72 Q:$D(ZTQUEUED) K IBCNT,IBECNT,IBEND,IHDT,IBN,IBND,IBPAG,IBQUIT,IBRNUM,IBRXN,IBRXN1,IBSL,IBSTART
73 D ^%ZISC
74 Q
75IBOERR ;error messages
76 ;;IB CROSS-REFERENCE BUT NO ENTRY
77 ;;IB ENTRY MISSING SOFTLINK
78 ;;RX ENTRY DELETED OR ARCHIVED
79 ;;RX ENTRY MISSING IB NODE
80 ;;RX ENTRY MISSING IB POINTER
81 ;;RX REFILL DELETED
82 ;;RX REFILL MISSING IB NODE
83 ;;RX REFILL MISSING IB LINK
Note: See TracBrowser for help on using the repository browser.