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

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1IBCSC6 ;ALB/MJB - MCCR SCREEN 6 (INPT. BILLING INFO) ;27 MAY 88 10:19
2 ;;2.0;INTEGRATED BILLING;**52,80,109,106,51,137,343**;21-MAR-94;Build 16
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;MAP TO DGCRSC6
6 ;
7EN I $P(^DGCR(399,IBIFN,0),"^",5)>2 G EN^IBCSC7
8 I $D(DGRVRCAL) D ^IBCU6 K DGRVRCAL
9 D ^IBCSCU S IBSR=6,IBSR1="",IBV1="0000000" S:IBV IBV1="1111111" F I="U","U1",0,"U2","U3" S IB(I)=$S($D(^DGCR(399,IBIFN,I)):^(I),1:"")
10 D H^IBCSCU
11 S IBBT=$P(IB(0),U,24)_$P(IB(0),U,5)_$P(IB(0),U,26)
12 S IBBT1=$P(IB(0),U,24)_$P($G(^DGCR(399.1,+$P(IB(0),U,25),0)),U,2)_$P(IB(0),U,26)
13 D 4^IBCVA1,5^IBCVA1
14 ;
151 S Z=1,IBW=1 X IBWW W " Bill Type : ",$S('$D(IBBT1):IBU,IBBT1="":IBU,1:IBBT1)
16 W $J("",14),"Loc. of Care: ",$E($G(IBBTP1),1,30) K IBBTP1
17 W !?4,"Covered Days: ",$S(IB("U2")="":IBU,$P(IB("U2"),U,2)'="":$P(IB("U2"),U,2),1:IBU)
18 W ?35,"Bill Classif: ",$E($G(IBBTP2),1,30) K IBBTP2
19 W !?4,"Non-Cov Days: ",$S(IB("U2")="":IBU,$P(IB("U2"),U,3)'="":$P(IB("U2"),U,3),1:IBU)
20 W ?38,"Timeframe: ",$S($D(IBBTP3):$E(IBBTP3,1,30),1:"") K IBBTP3
21 W !?4,"Charge Type : ",$S($P(IB(0),U,27)=1:"INSTITUTIONAL",$P(IB(0),U,27)=2:"PROFESSIONAL",1:IBU)
22 W ?39,"Division: ",$E($P($G(^DG(40.8,+$P(IB(0),U,22),0)),U,1),1,30)
23 ; PRXM/KJH - Add Taxonomy code to display for patch 343.
24 W !?34,"Div. Taxonomy: "
25 S IBZ=$$GET1^DIQ(8932.1,+$P(IB("U3"),U,2),"X12 CODE") W $S(IBZ'="":IBZ,1:IBU)
26 S IBZ=$$GET1^DIQ(8932.1,+$P(IB("U3"),U,2),"SPECIALTY CODE") W $S(IBZ'="":" ("_IBZ_")",1:"")
27 W !?4,"Form Type : ",$P($G(^IBE(353,+$P(IB(0),U,19),0)),U,1)
28 W ?34,"Co-Insur Days: ",$S($P(IB("U2"),U,7)="":$S($$MCRONBIL^IBEFUNC(IBIFN):IBU,1:IBUN),1:$P(IB("U2"),U,7))
29 ;
30 ;W !?4,"Provider # : ",$S(IB("U2")="":IBU,$P(IB("U2"),U,2)'="":$P(IB("U2"),U,2),1:IBU)
31 ;
32ROI S Z=2,IBW=1 X IBWW
33 W " Sensitive? : ",$S(IB("U")="":IBU,$P(IB("U"),U,5)="":IBU,$P(IB("U"),U,5)=1:"YES",1:"NO")
34 W ?46,"Assignment: ",$S(IB("U")="":IBU,$P(IB("U"),U,6)="":IBU,$P(IB("U"),U,6)["n":"NO",$P(IB("U"),U,6)["N":"NO",$P(IB("U"),U,6)=0:"NO",1:"YES")
35 I $P(IB("U"),U,5)=1 W !?4,"R.O.I. Form : ",$S($P(IB("U"),U,7)=1:"COMPLETED",$P(IB("U"),U,7)=0:"NOT COMPLETED",1:"STATUS UNKNOWN")
36 S IBOA="01^02^03^04^05^06^" F I=1:1:5 Q:'$D(IBOCN(I)) I IBOA[IBOCN(I)_"^" S IBOX=1
37 W:$D(IBOX) !,?4,"Pow of Atty : ",$S($P(IB("U"),U,3)=1:"COMPLETED",$P(IB("U"),U,3)=0:"NOT COMPLETED",1:"STATUS UNKNOWN")
38 ;
393 S Z=3,IBW=1 X IBWW D FROMTO
40 ;
41BED S Z=4,IBW=1 X IBWW
42 W " Bedsection : ",$S(IB("U")="":IBU,$P(IB("U"),U,11)'="":$P(^DGCR(399.1,$P(IB("U"),U,11),0),U,1),1:IBU)
43 ;S IBI=1,D1=0,IBLS=$S($D(DGNEWLOS):0,IB("U")="":0,$P(IB("U"),U,15)'="":$P(IB("U"),U,15),1:0) K DGNEWLOS
44 ;I 'IBLS S D0=DFN,(D1,DGPMIFN)=$O(^DGPM("AMV1",$P(IBIP,U,2),DFN,0)),X2=$P(IB("U"),"^"),X1=$P(IB("U"),"^",2) D ^%DTC S IBLS(1)=X
45 ;I 'IBLS K X D:DGPMIFN ^DGPMLOS S IBLS=$S($D(X):$P(X,U,5),1:IBLS(1)),IBLS=$S(IBLS(1)<IBLS:IBLS(1),1:IBLS) S:'IBLS IBLS=1 S (DA,Y)=IBIFN,DIE="^DGCR(399,",DR="165///"_IBLS D ^DIE K DR
46 W !?4,"LOS : ",IBLS
47 ;
48 I $P($G(^DPT(DFN,.3)),"^")="Y" D SC I IBSCM>0 W !?4,"PTF record indicates ",IBSCM," of ",IBM," movements are for Service Connected Care."
49 ;
50REV S Z=5,IBREVC=0,IBW=1 X IBWW W " Rev. Code : " F I=1:1:8 Q:'$D(IBREVC(I)) D:$S(IBREVC<7:1,1:$P(IBREVC(I),U,9)="") REV^IBCSC61 S IBREVC=IBREVC+1 Q:IBREVC>7
51 I $G(IBREVC)>9 W !,?4,"Too many Revenue Codes to display, enter '5' to list"
52BILL D OFFSET^IBCSC61
53 I $G(IBUCH),$$FT^IBCEF(IBIFN)=3 S X=IBUCH,X2="2$" D COMMA^%DTC W !,?39,"Non-Cov: ",X
54 ;
55RS S Z=6,IBW=1 X IBWW W " Rate Sched : (re-calculate charges)"
56 ;
57PRPAY S Z=7,IBW=1 X IBWW
58 S IB("M1")=$G(^DGCR(399,IBIFN,"M1")),X3=0,IBI="Prior Payments:" F X=0,1,2 D
59 . S X1=$P(IB("U2"),U,(X+4)),X2=$P(IB("M1"),U,(5+X)) I X1="",X2="" Q
60 . S IBI=IBI_$J("",(17-$L(IBI)))_$S(X=0:"Primary",X=1:"Secondary",X=2:"Tertiary",1:"")
61 . S IBI=IBI_$J("",(28-$L(IBI)))_$S(X1'="":$J(X1,11,2),1:IBU)
62 . S IBI=IBI_$J("",(50-$L(IBI)))_"Bill #: "_$S(+X2:$P($G(^DGCR(399,+X2,0)),U,1),1:IBU)
63 . W:'X3 " " W:X3 !,?4 W IBI S X3=1,IBI=""
64 I 'X3 W " Prior Claims: ",IBU
65 ;
66 G ^IBCSCP
67 Q
68 ;
69FROMTO ; - Print From and To dates of bill
70 W " Bill From : " S Y=$P(IB("U"),"^") D D^DIQ W $S($L(Y):Y,1:IBU)
71 W ?49,"Bill To: " S Y=$P(IB("U"),"^",2) D D^DIQ W $S($L(Y):Y,1:IBU)
72 Q
73 ;
74SC ; -if patient is sc, are movements for sc care
75 S PTF=$P(IB(0),"^",8)
76 ;
77SC1 ;
78 ; -input ptf
79 ;
80 ; -output IBm = number of movements
81 ; IBscm = number of SC movements
82 S (IBM,IBSCM,M)=0
83 I $S('PTF:1,'$D(^DGPT(PTF,0)):1,1:0) Q
84 F S M=$O(^DGPT(PTF,"M",M)) Q:'M S IBM=IBM+1 I $P($G(^DGPT(PTF,"M",M,0)),"^",18)=1 S IBSCM=IBSCM+1
85 Q
86 ;IBCSC6
Note: See TracBrowser for help on using the repository browser.