- 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
