IBCOPV2 ;ALB/LDB - ROUTINE TO LIST PATIENT VISITS ;30 APR 90
;;2.0;INTEGRATED BILLING;**52,91,106**;21-MAR-94
;
;MAP TO DGCROPV2
;
ELIG N IBCODN
Q:$D(DGNO) S (DGCOD,IBCODN)=$S(DGFIL'=2.101:+$P(DGNOD,U,3),1:"ADMITTING/SCREENING") I $D(^DIC(40.7,+IBCODN,0)) S:IBCODN DGCOD=$P(^DIC(40.7,+IBCODN,0),U)
I DGFIL=409.5,$P($G(^DIC(40.7,+IBCODN,0)),U,2)>899&($P($G(^DIC(40.7,+IBCODN,0)),U,2)<999) S DGCOD=$P(DGNOD,U,4) S:$D(^SC(+DGCOD,0)) DGCOD=$P(^(0),U,7) S:$D(^DIC(40.7,+DGCOD,0)) DGCOD=$P(^(0),U)
I DGFIL'=2.101 S IBCODCL=$P(DGNOD,U,4) S IBCODCL=$P($G(^SC(+IBCODCL,0)),U,1)
;
I (DGTYP="")!(DGTYP=9) S DGTYP=$S($D(^DPT(DFN,.36)):^(.36),1:"") S:DGTYP DGTYP=$E($G(^DIC(8,+DGTYP,0)),1,3)
I DGTYP'="NSC" S DGMT="" Q
S DGMT=$P($$LST^DGMTU(DFN,$P(I,".",1)),U,4)
Q
;
CHG S IBCHG=+$$BILLCOST^IBCRCI(IBIFN,DGDT,"OUTPATIENT VISIT DATE")
I +IBCHG S $P(^UTILITY($J,"OPV","AP",DGCNT),U,2)=IBCHG
Q
;
PROD F P=2:1 S DGCPT2=$P(^UTILITY($J,"CPT1",I7,DGNO),U,P) Q:DGCPT2="" D
.I $P(^DGCR(399,IBIFN,0),U,9)=4 D
..F I8=1:1:3 I $P($G(^DGCR(399,IBIFN,"C")),U,I8)=$P(^UTILITY($J,"CPT1",I7,DGNO),U,P) S $P(^UTILITY($J,"CPT1",I7,DGNO),U,P)=$P(^UTILITY($J,"CPT1",I7,DGNO),U,P)_"~0"
.I $D(^DGCR(399,IBIFN,"CP","B",DGCPT2_";ICPT(")) D
..F DGCPT0=0:0 S DGCPT0=$O(^DGCR(399,IBIFN,"CP","B",DGCPT2_";ICPT(",DGCPT0)) Q:'DGCPT0 D
...S $P(^UTILITY($J,"CPT1",I7,DGNO),U,P)=$S(^UTILITY($J,"CPT1",I7,DGNO)'[(DGCPT2_"~"_DGCPT0):(DGCPT2_"~"_DGCPT0),1:$P(^UTILITY($J,"CPT",I7,DGNO),U,P))
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCOPV2 1498 printed Oct 16, 2024@18:19:18 Page 2
IBCOPV2 ;ALB/LDB - ROUTINE TO LIST PATIENT VISITS ;30 APR 90
+1 ;;2.0;INTEGRATED BILLING;**52,91,106**;21-MAR-94
+2 ;
+3 ;MAP TO DGCROPV2
+4 ;
ELIG NEW IBCODN
+1 if $DATA(DGNO)
QUIT
SET (DGCOD,IBCODN)=$SELECT(DGFIL'=2.101:+$PIECE(DGNOD,U,3),1:"ADMITTING/SCREENING")
IF $DATA(^DIC(40.7,+IBCODN,0))
if IBCODN
SET DGCOD=$PIECE(^DIC(40.7,+IBCODN,0),U)
+2 IF DGFIL=409.5
IF $PIECE($GET(^DIC(40.7,+IBCODN,0)),U,2)>899&($PIECE($GET(^DIC(40.7,+IBCODN,0)),U,2)<999)
SET DGCOD=$PIECE(DGNOD,U,4)
if $DATA(^SC(+DGCOD,0))
SET DGCOD=$PIECE(^(0),U,7)
if $DATA(^DIC(40.7,+DGCOD,0))
SET DGCOD=$PIECE(^(0),U)
+3 IF DGFIL'=2.101
SET IBCODCL=$PIECE(DGNOD,U,4)
SET IBCODCL=$PIECE($GET(^SC(+IBCODCL,0)),U,1)
+4 ;
+5 IF (DGTYP="")!(DGTYP=9)
SET DGTYP=$SELECT($DATA(^DPT(DFN,.36)):^(.36),1:"")
if DGTYP
SET DGTYP=$EXTRACT($GET(^DIC(8,+DGTYP,0)),1,3)
+6 IF DGTYP'="NSC"
SET DGMT=""
QUIT
+7 SET DGMT=$PIECE($$LST^DGMTU(DFN,$PIECE(I,".",1)),U,4)
+8 QUIT
+9 ;
CHG SET IBCHG=+$$BILLCOST^IBCRCI(IBIFN,DGDT,"OUTPATIENT VISIT DATE")
+1 IF +IBCHG
SET $PIECE(^UTILITY($JOB,"OPV","AP",DGCNT),U,2)=IBCHG
+2 QUIT
+3 ;
PROD FOR P=2:1
SET DGCPT2=$PIECE(^UTILITY($JOB,"CPT1",I7,DGNO),U,P)
if DGCPT2=""
QUIT
Begin DoDot:1
+1 IF $PIECE(^DGCR(399,IBIFN,0),U,9)=4
Begin DoDot:2
+2 FOR I8=1:1:3
IF $PIECE($GET(^DGCR(399,IBIFN,"C")),U,I8)=$PIECE(^UTILITY($JOB,"CPT1",I7,DGNO),U,P)
SET $PIECE(^UTILITY($JOB,"CPT1",I7,DGNO),U,P)=$PIECE(^UTILITY($JOB,"CPT1",I7,DGNO),U,P)_"~0"
End DoDot:2
+3 IF $DATA(^DGCR(399,IBIFN,"CP","B",DGCPT2_";ICPT("))
Begin DoDot:2
+4 FOR DGCPT0=0:0
SET DGCPT0=$ORDER(^DGCR(399,IBIFN,"CP","B",DGCPT2_";ICPT(",DGCPT0))
if 'DGCPT0
QUIT
Begin DoDot:3
+5 SET $PIECE(^UTILITY($JOB,"CPT1",I7,DGNO),U,P)=$SELECT(^UTILITY($JOB,"CPT1",I7,DGNO)'[(DGCPT2_"~"_DGCPT0):(DGCPT2_"~"_DGCPT0),1:$PIECE(^UTILITY($JOB,"CPT",I7,DGNO),U,P))
End DoDot:3
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
