source: FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCSC6.m@ 628

IBCSC6 ;ALB/MJB - MCCR SCREEN 6 (INPT. BILLING INFO) ;27 MAY 88 10:19
 ;;2.0;INTEGRATED BILLING;**52,80,109,106,51,137,343**;21-MAR-94;Build 16
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
 ;MAP TO DGCRSC6
 ;
EN I $P(^DGCR(399,IBIFN,0),"^",5)>2 G EN^IBCSC7
 I $D(DGRVRCAL) D ^IBCU6 K DGRVRCAL
 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:"")
 D H^IBCSCU
 S IBBT=$P(IB(0),U,24)_$P(IB(0),U,5)_$P(IB(0),U,26)
 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)
 D 4^IBCVA1,5^IBCVA1
 ;
1 S Z=1,IBW=1 X IBWW W " Bill Type   : ",$S('$D(IBBT1):IBU,IBBT1="":IBU,1:IBBT1)
 W $J("",14),"Loc. of Care: ",$E($G(IBBTP1),1,30) K IBBTP1
 W !?4,"Covered Days: ",$S(IB("U2")="":IBU,$P(IB("U2"),U,2)'="":$P(IB("U2"),U,2),1:IBU)
 W ?35,"Bill Classif: ",$E($G(IBBTP2),1,30) K IBBTP2
 W !?4,"Non-Cov Days: ",$S(IB("U2")="":IBU,$P(IB("U2"),U,3)'="":$P(IB("U2"),U,3),1:IBU)
 W ?38,"Timeframe: ",$S($D(IBBTP3):$E(IBBTP3,1,30),1:"") K IBBTP3
 W !?4,"Charge Type : ",$S($P(IB(0),U,27)=1:"INSTITUTIONAL",$P(IB(0),U,27)=2:"PROFESSIONAL",1:IBU)
 W ?39,"Division: ",$E($P($G(^DG(40.8,+$P(IB(0),U,22),0)),U,1),1,30)
 ; PRXM/KJH - Add Taxonomy code to display for patch 343.
 W !?34,"Div. Taxonomy: "
 S IBZ=$$GET1^DIQ(8932.1,+$P(IB("U3"),U,2),"X12 CODE") W $S(IBZ'="":IBZ,1:IBU)
 S IBZ=$$GET1^DIQ(8932.1,+$P(IB("U3"),U,2),"SPECIALTY CODE") W $S(IBZ'="":" ("_IBZ_")",1:"")
 W !?4,"Form Type   : ",$P($G(^IBE(353,+$P(IB(0),U,19),0)),U,1)
 W ?34,"Co-Insur Days: ",$S($P(IB("U2"),U,7)="":$S($$MCRONBIL^IBEFUNC(IBIFN):IBU,1:IBUN),1:$P(IB("U2"),U,7))
 ;
 ;W !?4,"Provider # : ",$S(IB("U2")="":IBU,$P(IB("U2"),U,2)'="":$P(IB("U2"),U,2),1:IBU)
 ;
ROI S Z=2,IBW=1 X IBWW
 W " Sensitive?  : ",$S(IB("U")="":IBU,$P(IB("U"),U,5)="":IBU,$P(IB("U"),U,5)=1:"YES",1:"NO")
 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")
 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")
 S IBOA="01^02^03^04^05^06^" F I=1:1:5 Q:'$D(IBOCN(I))  I IBOA[IBOCN(I)_"^" S IBOX=1
 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")
 ;
3 S Z=3,IBW=1 X IBWW D FROMTO
 ;
BED S Z=4,IBW=1 X IBWW
 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)
 ;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
 ;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
 ;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
 W !?4,"LOS         : ",IBLS
 ;
 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."
 ;
REV 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
 I $G(IBREVC)>9 W !,?4,"Too many Revenue Codes to display, enter '5' to list"
BILL D OFFSET^IBCSC61
 I $G(IBUCH),$$FT^IBCEF(IBIFN)=3 S X=IBUCH,X2="2$" D COMMA^%DTC W !,?39,"Non-Cov: ",X
 ;
RS S Z=6,IBW=1 X IBWW W " Rate Sched  : (re-calculate charges)"
 ;
PRPAY S Z=7,IBW=1 X IBWW
 S IB("M1")=$G(^DGCR(399,IBIFN,"M1")),X3=0,IBI="Prior Payments:" F X=0,1,2 D
 . S X1=$P(IB("U2"),U,(X+4)),X2=$P(IB("M1"),U,(5+X)) I X1="",X2="" Q
 . S IBI=IBI_$J("",(17-$L(IBI)))_$S(X=0:"Primary",X=1:"Secondary",X=2:"Tertiary",1:"")
 . S IBI=IBI_$J("",(28-$L(IBI)))_$S(X1'="":$J(X1,11,2),1:IBU)
 . S IBI=IBI_$J("",(50-$L(IBI)))_"Bill #: "_$S(+X2:$P($G(^DGCR(399,+X2,0)),U,1),1:IBU)
 . W:'X3 " " W:X3 !,?4 W IBI S X3=1,IBI=""
 I 'X3 W " Prior Claims: ",IBU
 ;
 G ^IBCSCP
 Q
 ;
FROMTO ;  - Print From and To dates of bill
 W " Bill From   : " S Y=$P(IB("U"),"^") D D^DIQ W $S($L(Y):Y,1:IBU)
 W ?49,"Bill To: " S Y=$P(IB("U"),"^",2) D D^DIQ W $S($L(Y):Y,1:IBU)
 Q
 ;
SC ;  -if patient is sc, are movements for sc care
 S PTF=$P(IB(0),"^",8)
 ;
SC1 ;
 ;  -input ptf
 ;
 ;  -output IBm   = number of movements
 ;          IBscm = number of SC movements
 S (IBM,IBSCM,M)=0
 I $S('PTF:1,'$D(^DGPT(PTF,0)):1,1:0) Q
 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
 Q
 ;IBCSC6