IBCSC6 ;ALB/MJB - MCCR SCREEN 6 (INPT. BILLING INFO) ;27 MAY 88 10:19
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;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="00000" S:IBV IBV1="11111" F I="U","U1",0,"U2" S IB(I)=$S($D(^DGCR(399,IBIFN,I)):^(I),1:"")
D H^IBCSCU
S IBBT=$P(IB(0),U,4)_$P(IB(0),U,5)_$P(IB(0),U,6)
D 4^IBCVA1,5^IBCVA1
;
1 S Z=1,IBW=1 X IBWW W " Bill Type : ",$S('$D(IBBT):IBU,IBBT="":IBU,1:IBBT)
W ?46,"Timeframe: ",$S($D(IBTF):IBTF,1:"") K IBTF
;W !?4,"Provider # : ",$S(IB("U2")="":IBU,$P(IB("U2"),U,2)'="":$P(IB("U2"),U,2),1:IBU)
W !?4,"Covered Days: ",$S(IB("U2")="":IBU,$P(IB("U2"),U,2)'="":$P(IB("U2"),U,2),1:IBU)
W ?30,"Non-Covered Days: ",$S(IB("U2")="":IBU,$P(IB("U2"),U,3)'="":$P(IB("U2"),U,3),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 ?45,"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,IBW=1 X IBWW W " Rev. Code : " F I=1:1:10 Q:'$D(IBREVC(I)) D REV^IBCSC61
I $D(IBREVC(11)) W !,?4,"Too many Revenue Codes to display, enter '5' to list"
BILL D OFFSET^IBCSC61
W !?4,"FY 1 : ",$S($P(IB("U1"),U,9)]"":$P(IB("U1"),U,9),1:IBU),?40,"Charges: " S X=$P(IB("U1"),"^",10),X2="2$" D COMMA^%DTC W X
I $P(IB("U1"),U,11)]"" W !?4,"FY 2 : ",$P(IB("U1"),U,11) S X=+$P(IB("U1"),U,12),X2="2$" D COMMA^%DTC W ?40,"Charges: ",X
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 ?48,"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
IBCSC6 ;ALB/MJB - MCCR SCREEN 6 (INPT. BILLING INFO) ;27 MAY 88 10:19
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;MAP TO DGCRSC6
+5 ;
EN IF $PIECE(^DGCR(399,IBIFN,0),"^",5)>2
GOTO EN^IBCSC7
+1 IF $DATA(DGRVRCAL)
DO ^IBCU6
KILL DGRVRCAL
+2 DO ^IBCSCU
SET IBSR=6
SET IBSR1=""
SET IBV1="00000"
IF IBV
SET IBV1="11111"
FOR I="U","U1",0,"U2"
SET IB(I)=$SELECT($DATA(^DGCR(399,IBIFN,I)):^(I),1:"")
+3 DO H^IBCSCU
+4 SET IBBT=$PIECE(IB(0),U,4)_$PIECE(IB(0),U,5)_$PIECE(IB(0),U,6)
+5 DO 4^IBCVA1
DO 5^IBCVA1
+6 ;
1 SET Z=1
SET IBW=1
XECUTE IBWW
WRITE " Bill Type : ",$SELECT('$DATA(IBBT):IBU,IBBT="":IBU,1:IBBT)
+1 WRITE ?46,"Timeframe: ",$SELECT($DATA(IBTF):IBTF,1:"")
KILL IBTF
+2 ;W !?4,"Provider # : ",$S(IB("U2")="":IBU,$P(IB("U2"),U,2)'="":$P(IB("U2"),U,2),1:IBU)
+3 WRITE !?4,"Covered Days: ",$SELECT(IB("U2")="":IBU,$PIECE(IB("U2"),U,2)'="":$PIECE(IB("U2"),U,2),1:IBU)
+4 WRITE ?30,"Non-Covered Days: ",$SELECT(IB("U2")="":IBU,$PIECE(IB("U2"),U,3)'="":$PIECE(IB("U2"),U,3),1:IBU)
+5 ;
ROI SET Z=2
SET IBW=1
XECUTE IBWW
+1 WRITE " Sensitive? : ",$SELECT(IB("U")="":IBU,$PIECE(IB("U"),U,5)="":IBU,$PIECE(IB("U"),U,5)=1:"YES",1:"NO")
+2 WRITE ?45,"Assignment: ",$SELECT(IB("U")="":IBU,$PIECE(IB("U"),U,6)="":IBU,$PIECE(IB("U"),U,6)["n":"NO",$PIECE(IB("U"),U,6)["N":"NO",$PIECE(IB("U"),U,6)=0:"NO",1:"YES")
+3 IF $PIECE(IB("U"),U,5)=1
WRITE !?4,"R.O.I. Form : ",$SELECT($PIECE(IB("U"),U,7)=1:"COMPLETED",$PIECE(IB("U"),U,7)=0:"NOT COMPLETED",1:"STATUS UNKNOWN")
+4 SET IBOA="01^02^03^04^05^06^"
FOR I=1:1:5
IF '$DATA(IBOCN(I))
QUIT
IF IBOA[IBOCN(I)_"^"
SET IBOX=1
+5 IF $DATA(IBOX)
WRITE !,?4,"Pow of Atty : ",$SELECT($PIECE(IB("U"),U,3)=1:"COMPLETED",$PIECE(IB("U"),U,3)=0:"NOT COMPLETED",1:"STATUS UNKNOWN")
+6 ;
3 SET Z=3
SET IBW=1
XECUTE IBWW
DO FROMTO
+1 ;
BED SET Z=4
SET IBW=1
XECUTE IBWW
+1 WRITE " Bedsection : ",$SELECT(IB("U")="":IBU,$PIECE(IB("U"),U,11)'="":$PIECE(^DGCR(399.1,$PIECE(IB("U"),U,11),0),U,1),1:IBU)
+2 ;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
+3 ;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
+4 ;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
+5 WRITE !?4,"LOS : ",IBLS
+6 ;
+7 IF $PIECE($GET(^DPT(DFN,.3)),"^")="Y"
DO SC
IF IBSCM>0
WRITE !?4,"PTF record indicates ",IBSCM," of ",IBM," movements are for Service Connected Care."
REV SET Z=5
SET IBW=1
XECUTE IBWW
WRITE " Rev. Code : "
FOR I=1:1:10
IF '$DATA(IBREVC(I))
QUIT
DO REV^IBCSC61
+1 IF $DATA(IBREVC(11))
WRITE !,?4,"Too many Revenue Codes to display, enter '5' to list"
BILL DO OFFSET^IBCSC61
+1 WRITE !?4,"FY 1 : ",$SELECT($PIECE(IB("U1"),U,9)]"":$PIECE(IB("U1"),U,9),1:IBU),?40,"Charges: "
SET X=$PIECE(IB("U1"),"^",10)
SET X2="2$"
DO COMMA^%DTC
WRITE X
+2 IF $PIECE(IB("U1"),U,11)]""
WRITE !?4,"FY 2 : ",$PIECE(IB("U1"),U,11)
SET X=+$PIECE(IB("U1"),U,12)
SET X2="2$"
DO COMMA^%DTC
WRITE ?40,"Charges: ",X
+3 GOTO ^IBCSCP
+4 QUIT
+5 ;
FROMTO ; - Print From and To dates of bill
+1 WRITE " Bill From : "
SET Y=$PIECE(IB("U"),"^")
DO D^DIQ
WRITE $SELECT($LENGTH(Y):Y,1:IBU)
+2 WRITE ?48,"Bill To: "
SET Y=$PIECE(IB("U"),"^",2)
DO D^DIQ
WRITE $SELECT($LENGTH(Y):Y,1:IBU)
+3 QUIT
+4 ;
SC ; -if patient is sc, are movements for sc care
+1 SET PTF=$PIECE(IB(0),"^",8)
+2 ;
SC1 ;
+1 ; -input ptf
+2 ;
+3 ; -output IBm = number of movements
+4 ; IBscm = number of SC movements
+5 SET (IBM,IBSCM,M)=0
+6 IF $SELECT('PTF:1,'$DATA(^DGPT(PTF,0)):1,1:0)
QUIT
+7 FOR
SET M=$ORDER(^DGPT(PTF,"M",M))
IF 'M
QUIT
SET IBM=IBM+1
IF $PIECE($GET(^DGPT(PTF,"M",M,0)),"^",18)=1
SET IBSCM=IBSCM+1
+8 QUIT
+9 ;
+10 ;IBCSC6
