IBCCPT ;ALB/LDB/AAS - MCCR OUTPATIENT VISITS LISTING CONT. ; 29 MAY 90
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;MAP TO DGCRCPT
;
K DIR
EN D:$D(DIR) HLP W @IOF S DGU=0 K DGCPT,^UTILITY($J) D VST
D CHDR,WRNO
S (DGCNT,DGCNT1)=0 F S DGCNT=$O(^UTILITY($J,"CPT-CNT",DGCNT)) Q:'DGCNT S DGNOD=^(DGCNT),DGCPT=+DGNOD,DGDAT=$P(DGNOD,"^",2),DGBIL=$P(DGNOD,"^",3),DGASC=$P(DGNOD,"^",4),DGDIV=$P(DGNOD,"^",5),DGCNT1=DGCNT1+1 D CPRT I DGU="^" S DGCNT=DGCNT-1 Q
I DGU'="^" F Y=$Y:1:IOSL-6 W !
OK1 K Y Q:'$D(^UTILITY($J,"CPT-CNT"))!($D(DIR))
;OKS DIR(0)="LAO^1:"_DGCNT_"^Q:DGU=""^""",DIR("?")="^D EN^IBCCPT",DIR("A")="SELECT CPT CODE(S) TO INCLUDE IN THIS BILL: "
OK S DIR(0)="LAO^1:"_DGCNT1_"^K:X[""."" X",DIR("?")="^D EN^IBCCPT",DIR("A")="SELECT CPT CODE(S) TO INCLUDE IN THIS BILL: "
D ^DIR I 'Y D Q1^IBCOPV1 Q
S IBFT=+$P(^DGCR(399,IBIFN,0),"^",19)
OK2 W !,"YOU HAVE SELECTED CPT CODE(S) NUMBERED-",$E(Y,1,$L(Y)-1),!,"IS THIS CORRECT" S %=1 D YN^DICN I %=-1 S IBOUT=1 D Q^IBCOPV1 Q
I +Y,'% W !,"Respond 'Y'es to include these codes in the bill.",!,"Respond 'N'o to reselect." G OK2
I +Y,%=2 G OK
;
FILE S DGCPT1=Y,(DGCNT,DGCNT2)=0
S DIE="^DGCR(399,",DA=IBIFN,DR=".09///4" D ^DIE K DR,DA,DIE
S:'$D(^DGCR(399,IBIFN,"CP",0)) ^DGCR(399,IBIFN,"CP",0)="^399.0304AVI"
F I9=1:1 S I1=$P(DGCPT1,",",I9) Q:'I1 I $D(^UTILITY($J,"CPT-CNT",I1)) S DGNOD=^(I1) D FILE1
D Q1^IBCOPV1 Q
;
FILE1 ; file procedures, if BASC, only for 1 visit date
K DGNOADD S (X,DINUM)=$P(DGNOD,"^",2) D VFILE1^IBCOPV1 K DINUM,X
I $D(DGNOADD) W !?10,"Can't add Amb. Surg. ",$P(^ICPT(+DGNOD,0),"^")," without visit date!" Q ;don't add cpt for date that can't go on bill
I IBFT'=2,+$P(DGNOD,"^",4),$$TOMANY($P(DGNOD,"^",2)) W !?10,"Can't add Billable Amb. Surg. ",$P(^ICPT(+DGNOD,0),"^")," when more than one visit date!",*7 Q
W !?4,"Adding CPT Procedure: ",$P(^ICPT(+DGNOD,0),"^")
S DA(1)=IBIFN,DIC="^DGCR(399,"_DA(1)_",""CP"",",DIC(0)="L",X=+DGNOD_";ICPT(" K DD,DO D FILE^DICN S DA=+Y
S DR="1///"_$P(DGNOD,"^",2)_$S('$P(DGNOD,"^",4):"",1:";5////"_$P(DGNOD,"^",5))
S:IBFT=2 DR=DR_";8;9;D DISP1^IBCSC4D("_IBIFN_");10;S:X="""" Y=""@99"";11;S:X="""" Y=""@99"";12;S:X="""" Y=""@99"";13;@99"
S DIE=DIC D ^DIE
L ^DGCR(399,IBIFN):1
K DIE,DIC,DR,DA
Q
CPRT D:$Y+6>IOSL SCR Q:DGU="^"
I $D(^ICPT(DGCPT,0)) W !,DGCNT,")",?5,$P(^(0),"^"),?13,$S(DGASC:"YES",1:""),?20,$E($P(^(0),"^",2),1,28),?50 S Y=DGDAT D DT^DIQ I DGBIL W ?64," *ON THIS BILL*"
Q
CHDR W @IOF,!,?15,"<<CURRENT PROCEDURAL TERMINOLOGY CODES>>",!!,?10,"LISTING FROM VISIT DATES WITH ASSOCIATED CPT CODES",!,?22,"IN SCHEDULING VISITS FILE",!
S L="",$P(L,"=",80)="" W !,L,!,"NO.",?5,"CODE",?13,"BASC",?20,"SHORT NAME",?50,"PROCEDURE DATE",!,L,! K L Q
VST S DGCNT=0 I $O(^DGCR(399,IBIFN,"OP",0)) F V=0:0 S V=$O(^DGCR(399,IBIFN,"OP",V)) Q:'V S (IBOPV1,IBOPV2)=V D ASC
Q:$O(^DGCR(399,IBIFN,"OP",0))
S IBOPV1=$P(^DGCR(399,IBIFN,"U"),"^"),IBOPV2=$P(^("U"),"^",2)
D ASC
Q
WRNO W:'$O(^UTILITY($J,"CPT-CNT",0)) !,"NO CPT CODES IN SCHEDULING VISITS FILE FOR THE ",$S($O(^DGCR(399,IBIFN,"OP",0)):"VISIT DATES ON THIS BILL",1:"PERIOD THAT THIS STATEMENT COVERS")
Q
SCR Q:DGU="^" I $E(IOST,1,2)["C-",$Y+6>IOSL F Y=$Y:1:IOSL-5 W !
I R !,"Press return to continue or ""^"" to exit display ",DGU:DTIME D:DGU'="^" CHDR
Q
HLP W !!,"Enter a number between 1 and ",DGCNT1," or a range of numbers separated with commas",!,"or dashes, e.g., 1,3,5 or 2-4,8"
W !,"The number(s) must appear as a selectable number in the sequential list." R H:5 K H Q
CPT S DA(1)=IBIFN,IBCCPTZ=$P(^DGCR(399,DA(1),0),U,9),IBCCPTX=$S($D(^DGCR(399,DA(1),"C"))&IBCCPTZ:1,1:0)
K DIK,DGTE,I1 Q
;
ASC ; -find ambulatory procedures, flag if billable
; - ^utility($j,cpt-cnt,count)=code^date^already on bill^is BASC^divis
;
F I=IBOPV1:0 S I=$O(^SDV("C",DFN,I)) Q:'I!(I>(IBOPV2+.99)) I $D(^SDV(I,0)) S DGDIV=$P(^(0),"^",3) D
.F I1=0:0 S I1=$O(^SDV(I,"CS",I1)) Q:'I1 I $D(^(I1,0)) S DGNOD=^(0) I $D(^("PR")),$$DSP^IBEFUNC($P(DGNOD,"^",5),I) S DGCPTS=^SDV(I,"CS",I1,"PR"),I7=$P(I,".") I DGCPTS'="" D
..S:'$D(^UTILITY($J,"CPT",I,0)) ^(0)="Y"
..F I2=1:1:5 S DGCPT=$P(DGCPTS,"^",I2) I DGCPT'="" S DGCNT=DGCNT+1 S ^UTILITY($J,"CPT-CNT",DGCNT)=DGCPT_"^"_I7_"^"_$S($D(^DGCR(399,IBIFN,"CP","B",DGCPT_";ICPT(")):1,1:"")_"^"_$S(+$$CPTCHG^IBEFUNC1(DGCPT,DGDIV,I7):1,1:0)_"^"_DGDIV
Q
TOMANY(DATE) ; - returns 1 if more than 1 visit date on bill (for basc)
G TOMANYQ:'$D(DATE)
S DGVCNT=+$P($G(^DGCR(399,IBIFN,"OP",0)),"^",4)
I DGVCNT>1!(DGVCNT=1&('$D(^DGCR(399,IBIFN,"OP",DATE)))) K DGVCNT Q 1
TOMANYQ Q 0
IBCCPT ;ALB/LDB/AAS - MCCR OUTPATIENT VISITS LISTING CONT. ; 29 MAY 90
+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 DGCRCPT
+5 ;
+6 KILL DIR
EN IF $DATA(DIR)
DO HLP
WRITE @IOF
SET DGU=0
KILL DGCPT,^UTILITY($JOB)
DO VST
+1 DO CHDR
DO WRNO
+2 SET (DGCNT,DGCNT1)=0
FOR
SET DGCNT=$ORDER(^UTILITY($JOB,"CPT-CNT",DGCNT))
IF 'DGCNT
QUIT
SET DGNOD=^(DGCNT)
SET DGCPT=+DGNOD
SET DGDAT=$PIECE(DGNOD,"^",2)
SET DGBIL=$PIECE(DGNOD,"^",3)
SET DGASC=$PIECE(DGNOD,"^",4)
SET DGDIV=$PIECE(DGNOD,"^",5)
SET DGCNT1=DGCNT1+1
DO CPRT
IF DGU="^"
SET DGCNT=DGCNT-1
QUIT
+3 IF DGU'="^"
FOR Y=$Y:1:IOSL-6
WRITE !
OK1 KILL Y
IF '$DATA(^UTILITY($JOB,"CPT-CNT"))!($DATA(DIR))
QUIT
+1 ;OKS DIR(0)="LAO^1:"_DGCNT_"^Q:DGU=""^""",DIR("?")="^D EN^IBCCPT",DIR("A")="SELECT CPT CODE(S) TO INCLUDE IN THIS BILL: "
OK SET DIR(0)="LAO^1:"_DGCNT1_"^K:X[""."" X"
SET DIR("?")="^D EN^IBCCPT"
SET DIR("A")="SELECT CPT CODE(S) TO INCLUDE IN THIS BILL: "
+1 DO ^DIR
IF 'Y
DO Q1^IBCOPV1
QUIT
+2 SET IBFT=+$PIECE(^DGCR(399,IBIFN,0),"^",19)
OK2 WRITE !,"YOU HAVE SELECTED CPT CODE(S) NUMBERED-",$EXTRACT(Y,1,$LENGTH(Y)-1),!,"IS THIS CORRECT"
SET %=1
DO YN^DICN
IF %=-1
SET IBOUT=1
DO Q^IBCOPV1
QUIT
+1 IF +Y
IF '%
WRITE !,"Respond 'Y'es to include these codes in the bill.",!,"Respond 'N'o to reselect."
GOTO OK2
+2 IF +Y
IF %=2
GOTO OK
+3 ;
FILE SET DGCPT1=Y
SET (DGCNT,DGCNT2)=0
+1 SET DIE="^DGCR(399,"
SET DA=IBIFN
SET DR=".09///4"
DO ^DIE
KILL DR,DA,DIE
+2 IF '$DATA(^DGCR(399,IBIFN,"CP",0))
SET ^DGCR(399,IBIFN,"CP",0)="^399.0304AVI"
+3 FOR I9=1:1
SET I1=$PIECE(DGCPT1,",",I9)
IF 'I1
QUIT
IF $DATA(^UTILITY($JOB,"CPT-CNT",I1))
SET DGNOD=^(I1)
DO FILE1
+4 DO Q1^IBCOPV1
QUIT
+5 ;
FILE1 ; file procedures, if BASC, only for 1 visit date
+1 KILL DGNOADD
SET (X,DINUM)=$PIECE(DGNOD,"^",2)
DO VFILE1^IBCOPV1
KILL DINUM,X
+2 ;don't add cpt for date that can't go on bill
IF $DATA(DGNOADD)
WRITE !?10,"Can't add Amb. Surg. ",$PIECE(^ICPT(+DGNOD,0),"^")," without visit date!"
QUIT
+3 IF IBFT'=2
IF +$PIECE(DGNOD,"^",4)
IF $$TOMANY($PIECE(DGNOD,"^",2))
WRITE !?10,"Can't add Billable Amb. Surg. ",$PIECE(^ICPT(+DGNOD,0),"^")," when more than one visit date!",*7
QUIT
+4 WRITE !?4,"Adding CPT Procedure: ",$PIECE(^ICPT(+DGNOD,0),"^")
+5 SET DA(1)=IBIFN
SET DIC="^DGCR(399,"_DA(1)_",""CP"","
SET DIC(0)="L"
SET X=+DGNOD_";ICPT("
KILL DD,DO
DO FILE^DICN
SET DA=+Y
+6 SET DR="1///"_$PIECE(DGNOD,"^",2)_$SELECT('$PIECE(DGNOD,"^",4):"",1:";5////"_$PIECE(DGNOD,"^",5))
+7 IF IBFT=2
SET DR=DR_";8;9;D DISP1^IBCSC4D("_IBIFN_");10;S:X="""" Y=""@99"";11;S:X="""" Y=""@99"";12;S:X="""" Y=""@99"";13;@99"
+8 SET DIE=DIC
DO ^DIE
+9 LOCK ^DGCR(399,IBIFN):1
+10 KILL DIE,DIC,DR,DA
+11 QUIT
CPRT IF $Y+6>IOSL
DO SCR
IF DGU="^"
QUIT
+1 IF $DATA(^ICPT(DGCPT,0))
WRITE !,DGCNT,")",?5,$PIECE(^(0),"^"),?13,$SELECT(DGASC:"YES",1:""),?20,$EXTRACT($PIECE(^(0),"^",2),1,28),?50
SET Y=DGDAT
DO DT^DIQ
IF DGBIL
WRITE ?64," *ON THIS BILL*"
+2 QUIT
CHDR WRITE @IOF,!,?15,"<<CURRENT PROCEDURAL TERMINOLOGY CODES>>",!!,?10,"LISTING FROM VISIT DATES WITH ASSOCIATED CPT CODES",!,?22,"IN SCHEDULING VISITS FILE",!
+1 SET L=""
SET $PIECE(L,"=",80)=""
WRITE !,L,!,"NO.",?5,"CODE",?13,"BASC",?20,"SHORT NAME",?50,"PROCEDURE DATE",!,L,!
KILL L
QUIT
VST SET DGCNT=0
IF $ORDER(^DGCR(399,IBIFN,"OP",0))
FOR V=0:0
SET V=$ORDER(^DGCR(399,IBIFN,"OP",V))
IF 'V
QUIT
SET (IBOPV1,IBOPV2)=V
DO ASC
+1 IF $ORDER(^DGCR(399,IBIFN,"OP",0))
QUIT
+2 SET IBOPV1=$PIECE(^DGCR(399,IBIFN,"U"),"^")
SET IBOPV2=$PIECE(^("U"),"^",2)
+3 DO ASC
+4 QUIT
WRNO IF '$ORDER(^UTILITY($JOB,"CPT-CNT",0))
WRITE !,"NO CPT CODES IN SCHEDULING VISITS FILE FOR THE ",$SELECT($ORDER(^DGCR(399,IBIFN,"OP",0)):"VISIT DATES ON THIS BILL",1:"PERIOD THAT THIS STATEMENT COVERS")
+1 QUIT
SCR IF DGU="^"
QUIT
IF $EXTRACT(IOST,1,2)["C-"
IF $Y+6>IOSL
FOR Y=$Y:1:IOSL-5
WRITE !
+1 IF $TEST
READ !,"Press return to continue or ""^"" to exit display ",DGU:DTIME
IF DGU'="^"
DO CHDR
+2 QUIT
HLP WRITE !!,"Enter a number between 1 and ",DGCNT1," or a range of numbers separated with commas",!,"or dashes, e.g., 1,3,5 or 2-4,8"
+1 WRITE !,"The number(s) must appear as a selectable number in the sequential list."
READ H:5
KILL H
QUIT
CPT SET DA(1)=IBIFN
SET IBCCPTZ=$PIECE(^DGCR(399,DA(1),0),U,9)
SET IBCCPTX=$SELECT($DATA(^DGCR(399,DA(1),"C"))&IBCCPTZ:1,1:0)
+1 KILL DIK,DGTE,I1
QUIT
+2 ;
ASC ; -find ambulatory procedures, flag if billable
+1 ; - ^utility($j,cpt-cnt,count)=code^date^already on bill^is BASC^divis
+2 ;
+3 FOR I=IBOPV1:0
SET I=$ORDER(^SDV("C",DFN,I))
IF 'I!(I>(IBOPV2+.99))
QUIT
IF $DATA(^SDV(I,0))
SET DGDIV=$PIECE(^(0),"^",3)
Begin DoDot:1
+4 FOR I1=0:0
SET I1=$ORDER(^SDV(I,"CS",I1))
IF 'I1
QUIT
IF $DATA(^(I1,0))
SET DGNOD=^(0)
IF $DATA(^("PR"))
IF $$DSP^IBEFUNC($PIECE(DGNOD,"^",5),I)
SET DGCPTS=^SDV(I,"CS",I1,"PR")
SET I7=$PIECE(I,".")
IF DGCPTS'=""
Begin DoDot:2
+5 IF '$DATA(^UTILITY($JOB,"CPT",I,0))
SET ^(0)="Y"
+6 FOR I2=1:1:5
SET DGCPT=$PIECE(DGCPTS,"^",I2)
IF DGCPT'=""
SET DGCNT=DGCNT+1
SET ^UTILITY($JOB,"CPT-CNT",DGCNT)=DGCPT_"^"_I7_"^"_$SELECT($DATA(^DGCR(399,IBIFN,"CP","B",DGCPT_";ICPT(")):1,1:"")_"^"_$SELECT(+$$CPTCHG^IBEFUNC1(DGCPT,DGDIV,I7):1,1:0)_"^"_DGDIV
End DoDot:2
End DoDot:1
+7 QUIT
TOMANY(DATE) ; - returns 1 if more than 1 visit date on bill (for basc)
+1 IF '$DATA(DATE)
GOTO TOMANYQ
+2 SET DGVCNT=+$PIECE($GET(^DGCR(399,IBIFN,"OP",0)),"^",4)
+3 IF DGVCNT>1!(DGVCNT=1&('$DATA(^DGCR(399,IBIFN,"OP",DATE))))
KILL DGVCNT
QUIT 1
TOMANYQ QUIT 0
