- 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