IBCU71.m

IBCU71	;ALB/AAS - INTERCEPT SCREEN INPUT OF PROCEDURE CODES ; 29-OCT-91

	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

	;;Per VHA Directive 10-93-142, this routine should not be modified.

	;

	;MAP TO DGCRU71

	;

ADDCPT	;  - store cpt codes in scheduling visits file

	Q:$D(DGCPT)'>9

	N DA,DIC,DR,DIE

	S DIR(0)="Y",DIR("A")="OK to add CPT codes to Scheduling Visits file",DIR("B")="Y" D ^DIR K DIR Q:'Y!$D(DIRUT)

	K SDCPT

	S SDATE=DGPROCDT,SDIV=+$$SITE^VASITE,SDC=900,SDCTYPE="C",SDMSG="B"

	W !!,"Adding Procedures to Scheduling Visits file."

	S CNT=0 S I=0 F  S I=$O(DGCPT(I)) Q:'I  S J=0 F K=1:1 S J=$O(DGCPT(I,J)) Q:'J  F L=0:0 S L=$O(DGCPT(I,J,L)) Q:'L  S:K>5 K=1 S:K=1 CNT=CNT+1,SDCPT(CNT)="900^"_I_"^" S SDCPT(CNT)=SDCPT(CNT)_J_"^" W "."

	I $D(SDCPT) D EN3^SDACS W "..Done.",!

	K SDCPT,SDATE,SDIV,DGCPT,SDC,SDCTYPE,SDMSG

	Q

	;

DISPDX	;  - display diagnosis codes available for associated dx (HCFA 1500)  NO LONGER USED?

	N I,J,X,IBDX,IBDXL

	F I=1:1:4 S IBDX=$P($G(^DGCR(399,IBIFN,"C")),"^",(I+13)),X=$G(^ICD9(+IBDX,0)) I X'="" S IBDXL(I)=IBDX_"^"_X

	I '$D(IBDXL) W !!,"Bill has no ICD DIAGNOSIS." Q

	W !!,?24,"<<<ASSOCIATED ICD-9 DIAGNOSIS>>>",!!

	F I=1,2 W ! S X=0 F J=0,2 I $D(IBDXL(I+J)) S IBDX=IBDXL(I+J) D  S X=40

	. W ?X,"    ",$P(IBDX,"^",2),?(X+13),$E($P(IBDX,"^",4),1,28)

	W !

	Q

	;

SCREEN(X,Y)	; -- screen logic for active procs or surgeries

	; -- input x = date to check

	;          y = procedure

	;

	; -- output 0 if not active for billing or amb proc on date

	;           1 if either active

	;

	I '$D(X)!('$D(Y)) Q 0

	I $D(^SD(409.72,+$O(^(+$O(^SD(409.72,"AIVDT",Y,(9999998-$P(X,".")))),0)),0)),$P(^(0),U,5) Q 1

	I $D(^IBE(350.4,+$O(^(+$O(^IBE(350.4,"AIVDT",Y,-($P(X,".")))),0)),0)),$P(^(0),U,4) Q 1

	Q 0

IBCU71    ;ALB/AAS - INTERCEPT SCREEN INPUT OF PROCEDURE CODES ; 29-OCT-91

 +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 DGCRU71

 +5       ;

ADDCPT    ;  - store cpt codes in scheduling visits file

 +1        IF $DATA(DGCPT)'>9

               QUIT 

 +2        NEW DA,DIC,DR,DIE

 +3        SET DIR(0)="Y"

           SET DIR("A")="OK to add CPT codes to Scheduling Visits file"

           SET DIR("B")="Y"

           DO ^DIR

           KILL DIR

           IF 'Y!$DATA(DIRUT)

               QUIT 

 +4        KILL SDCPT

 +5        SET SDATE=DGPROCDT

           SET SDIV=+$$SITE^VASITE

           SET SDC=900

           SET SDCTYPE="C"

           SET SDMSG="B"

 +6        WRITE !!,"Adding Procedures to Scheduling Visits file."

 +7        SET CNT=0

           SET I=0

           FOR 

               SET I=$ORDER(DGCPT(I))

               IF 'I

                   QUIT 

               SET J=0

               FOR K=1:1

                   SET J=$ORDER(DGCPT(I,J))

                   IF 'J

                       QUIT 

                   FOR L=0:0

                       SET L=$ORDER(DGCPT(I,J,L))

                       IF 'L

                           QUIT 

                       IF K>5

                           SET K=1

                       IF K=1

                           SET CNT=CNT+1

                           SET SDCPT(CNT)="900^"_I_"^"

                       SET SDCPT(CNT)=SDCPT(CNT)_J_"^"

                       WRITE "."

 +8        IF $DATA(SDCPT)

               DO EN3^SDACS

               WRITE "..Done.",!

 +9        KILL SDCPT,SDATE,SDIV,DGCPT,SDC,SDCTYPE,SDMSG

 +10       QUIT 

 +11      ;

DISPDX    ;  - display diagnosis codes available for associated dx (HCFA 1500)  NO LONGER USED?

 +1        NEW I,J,X,IBDX,IBDXL

 +2        FOR I=1:1:4

               SET IBDX=$PIECE($GET(^DGCR(399,IBIFN,"C")),"^",(I+13))

               SET X=$GET(^ICD9(+IBDX,0))

               IF X'=""

                   SET IBDXL(I)=IBDX_"^"_X

 +3        IF '$DATA(IBDXL)

               WRITE !!,"Bill has no ICD DIAGNOSIS."

               QUIT 

 +4        WRITE !!,?24,"<<<ASSOCIATED ICD-9 DIAGNOSIS>>>",!!

 +5        FOR I=1,2

               WRITE !

               SET X=0

               FOR J=0,2

                   IF $DATA(IBDXL(I+J))

                       SET IBDX=IBDXL(I+J)

                       Begin DoDot:1

 +6                        WRITE ?X,"    ",$PIECE(IBDX,"^",2),?(X+13),$EXTRACT($PIECE(IBDX,"^",4),1,28)

                       End DoDot:1

                       SET X=40

 +7        WRITE !

 +8        QUIT 

 +9       ;

SCREEN(X,Y) ; -- screen logic for active procs or surgeries

 +1       ; -- input x = date to check

 +2       ;          y = procedure

 +3       ;

 +4       ; -- output 0 if not active for billing or amb proc on date

 +5       ;           1 if either active

 +6       ;

 +7        IF '$DATA(X)!('$DATA(Y))

               QUIT 0

 +8        IF $DATA(^SD(409.72,+$ORDER(^(+$ORDER(^SD(409.72,"AIVDT",Y,(9999998-$PIECE(X,".")))),0)),0))

               IF $PIECE(^(0),U,5)

                   QUIT 1

 +9        IF $DATA(^IBE(350.4,+$ORDER(^(+$ORDER(^IBE(350.4,"AIVDT",Y,-($PIECE(X,".")))),0)),0))

               IF $PIECE(^(0),U,4)

                   QUIT 1

 +10       QUIT 0