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

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1IBCF1 ;ALB/MJB/AAS - PRINT UB-82 BILL ;10 JUN 88 14:42
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;MAP TO DGCRP
6 ;
7ZIS Q:'$D(IBAC) S:'$D(IBPNT) IBPNT=0
8 ;S DGPGM="ENP^IBCF1",DGVAR="DFN^IBCIFN^IBC^IBEPAR^IBCDPT^IBCU^IBPNT" D ZIS^DGUTQ I POP G Q
9 ;
10DEV S %ZIS="Q",%ZIS("A")="Output Device: "
11 S %ZIS("B")=$P($G(^IBE(353,+$P($G(^DGCR(399,IBIFN,0)),"^",19),0)),"^",2)
12 D ^%ZIS G:POP Q
13 I $D(IO("Q")) S ZTRTN="ENP^IBCF1",ZTDESC="PRINT BILL",ZTSAVE("IB*")="",ZTSAVE("DG*")="",ZTSAVE("DFN")="" D ^%ZTLOAD K IO("Q") D HOME^%ZIS G Q
14 ;
15 U IO D ENP
16Q S IBKILL=1 D Q5^IBCVA
17 D:'$D(ZTQUEUED) ^%ZISC
18 K IBKILL Q
19 ;
20Q1 K DFN,IBIFN Q
21ENP Q:'$D(DFN) D SET D:$D(IBIFN) ALL^IBCVA0 D EN1^IBCVA0,EN4^IBCVA1,EN5^IBCVA1,^IBCF12
22EN2 W @IOF I IB("I1")]"",$P(IB("I1"),U,1)]"",$P($G(^DIC(36,$P(IB("I1"),U,1),0)),U,3)=1 W "##SR"
23 W ?24,$S(IBPNT=1:"",IBPNT=0:"*** COPY OF ORIGINAL BILL ***",IBPNT=2:"*** SECOND NOTICE ***",IBPNT=3:"*** THIRD NOTICE ***",1:"")
24 ;
251 F I=1,2 W !,$S(IBEPAR(2)]"":$P(IBEPAR(2),U,I),1:"")
26 W ?24,$P(IB("U1"),U,4),?57,IBBNO,?74,IBBT
272 I IBEPAR(2)]"" W !,$P(IBEPAR(2),U,3) S IBOPST=$P(IBEPAR(2),U,4),IBOPST=$P(^DIC(5,IBOPST,0),"^",2) W ?$X+2,IBOPST,?$X+2,$P(IBEPAR(2),U,5)
283 W !,$S(IBEPAR(2)]"":$P(IBEPAR(2),U,6),1:"")
29 S X=$P(IBEPAR(1),"^",6) W ?24,$S($P(IB("U"),U,14)]"":$P(IB("U"),U,14),1:X),?38,$P(IBEPAR(1),U,5),?50,$P(IBEPAR(1),"^",21),?71,$P(IB("U1"),U,5)
304 W !!,VADM(1),?33,$S(IB("M")']"":"",$P(IB("M"),U,10)]"":$P(IB("M"),U,10),1:"")
315 W !!,$E($P(VADM(3),U),4,7)_$E($P(VADM(3),U),2,3),?8,$P(VADM(5),U),?10 S Y=$P(IBDPT(0),U,5) W $S(Y=1:"D",Y=2:"M",Y=4:"W",Y=5:"X",Y=6:"S",1:"U")
32 W:$D(IBIP) ?14,$S($P(IBIP,U,2)'="":$E($P(IBIP,U,2),4,7)_$E($P(IBIP,U,2),2,3),1:$E(IBDT,4,7)_$E(IBDT,2,3)),?21,$S($E($P($P(IBIP,U,2),".",2),1,2)'="":$E($P($P(IBIP,U,2),".",2),1,2),1:"99")
33 W:$D(IBIP) ?24,$S($P(IBIP,U,5)'="":$P(IBIP,U,5),1:9),?27,$S($P(IBIP,U,4)'="":$P(IBIP,U,4),1:9),?29,$S($P(IBIP,U,3)'="":$P(IBIP,U,3),1:"99")
34 I $D(IBIP) W ?32,$S($P(IBIP,U,6)']"":"99",1:$E($P($P(IBIP,U,6),".",2),1,2)) S X=$P(IBIP,U,7) W ?36,$S($D(^DGCR(399.1,+X,0)):$P(^(0),"^",2),1:"")
35 I '$D(IBIP) W ?14,$E(IBDT,4,7)_$E(IBDT,2,3),?21,"99"
36 W ?40,$E($P(IB("U"),"^"),4,7)_$E($P(IB("U"),"^"),2,3),?48,$E($P(IB("U"),"^",2),4,7)_$E($P(IB("U"),"^",2),2,3),?70,$P(IB("U1"),U,6),!!
376 I $D(IBO(1)) W IBO(1),?3,$E(IBOCD(1),4,7)_$E(IBOCD(1),2,3) I $D(IBO(2)) W ?11,IBO(2),?14,$E(IBOCD(2),4,7)_$E(IBOCD(2),2,3) I $D(IBO(3)) W ?22,IBO(3),?25,$E(IBOCD(3),4,7)_$E(IBOCD(3),2,3)
38 I $D(IBO(4)) W ?35,IBO(4),?38,$E(IBOCD(4),4,7)_$E(IBOCD(4),2,3) I $D(IBO(5)) W ?46,IBO(5),?49,$E(IBOCD(5),4,7)_$E(IBOCD(5),2,3)
39 D 7^IBCF10 I DGPAG<DGTOTPAG S DGPAG=DGPAG+1 G EN2
40 Q
41SET ;Set Variables
42 D 2^VADPT F I=0,.11,.121,.25,.311,.36 S IBDPT(I)=$S($D(^DPT(DFN,I)):^(I),1:"")
43 F I=0,"C","I1","I2","I3","M","M1","S","U","U1" S IB(I)=$S($D(^DGCR(399,IBIFN,I)):^(I),1:"")
44 F I=0,1,2 S IBEPAR(I)=$G(^IBE(350.9,1,I))
45 S IBBT=$P(IB(0),"^",4)_$P(IB(0),"^",5)_$P(IB(0),"^",6)
46 S IBU="UNSPECIFIED" Q
47 ;IBCF1
Note: See TracBrowser for help on using the repository browser.