IBTRKR2.m

IBTRKR2	;ALB/AAS - ADD/TRACK SCHEDULED ADMISSION ; 9-AUG-93

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

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

	;

%	;

EN	; -- add scheduled admissions to claims tracking file

	N I,J,X,Y,IBTRKR,IBI,IBJ,DFN,IBDATA

	S IBTRKR=$G(^IBE(350.9,1,6))

	G:'$P(IBTRKR,"^",2) ENQ ; inpatient tracking off

	S:'$G(IBTSBDT) IBTSBDT=$$FMADD^XLFDT(DT,-3)-.1

	S:'$G(IBTSEDT) IBTSEDT=$$FMADD^XLFDT(DT,7)+.9

	I IBTSBDT<+IBTRKR S IBTSBDT=+IBTRKR-.1 ; start date can't be before ct start date

	S IBI=IBTSBDT-.0001 F  S IBI=$O(^DGS(41.1,"C",IBI)) Q:'IBI!(IBI>IBTSEDT)  S IBJ="" F  S IBJ=$O(^DGS(41.1,"C",IBI,IBJ)) Q:'IBJ  D

	.S IBDATA=$G(^DGS(41.1,IBJ,0))

	.S DFN=+IBDATA

	.Q:'DFN  ;  no patient

	.Q:$P(IBDATA,"^",13)  ; canceled

	.Q:$P(IBDATA,"^",17)  ; already admitted

	.;if not in ct add

	.S IBTRN=$O(^IBT(356,"ASCH",IBJ,0))

	.I 'IBTRN D  Q

	..I $P(IBTRKR,"^",2)=2 D SCH^IBTUTL2(DFN,IBI,IBJ) Q

	..I $P(IBTRKR,"^",2)=1,$$INSURED^IBCNS1(DFN,+IBI) D SCH^IBTUTL2(DFN,IBI,IBJ)

	..Q

	.; -- if inactive re-activate

	.I '$P(^IBT(356,+IBTRN,0),"^",20) D

	..N X,Y,I,J,DA,DR,DIE,DIC

	..S DA=IBTRN,DR=".2////1",DIE="^IBT(356," D ^DIE

	.Q

	;

ENQ	K IBTSEDT,IBTSBDT

	Q

	;

SCH(DGPMCA)	; -- is this admission movement a scheduled admission

	; -- output scheduled admission pointer

	;

	N IBTSA S IBTSA=0

	I '$G(DGPMCA) G SCHQ

	S IBTSA=+$O(^DGS(41.1,"AMVT",DGPMCA,0))

SCHQ	Q IBTSA

IBTRKR2   ;ALB/AAS - ADD/TRACK SCHEDULED ADMISSION ; 9-AUG-93

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

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

 +3       ;

%         ;

EN        ; -- add scheduled admissions to claims tracking file

 +1        NEW I,J,X,Y,IBTRKR,IBI,IBJ,DFN,IBDATA

 +2        SET IBTRKR=$GET(^IBE(350.9,1,6))

 +3       ; inpatient tracking off

           IF '$PIECE(IBTRKR,"^",2)

               GOTO ENQ

 +4        IF '$GET(IBTSBDT)

               SET IBTSBDT=$$FMADD^XLFDT(DT,-3)-.1

 +5        IF '$GET(IBTSEDT)

               SET IBTSEDT=$$FMADD^XLFDT(DT,7)+.9

 +6       ; start date can't be before ct start date

           IF IBTSBDT<+IBTRKR

               SET IBTSBDT=+IBTRKR-.1

 +7        SET IBI=IBTSBDT-.0001

           FOR 

               SET IBI=$ORDER(^DGS(41.1,"C",IBI))

               IF 'IBI!(IBI>IBTSEDT)

                   QUIT 

               SET IBJ=""

               FOR 

                   SET IBJ=$ORDER(^DGS(41.1,"C",IBI,IBJ))

                   IF 'IBJ

                       QUIT 

                   Begin DoDot:1

 +8                    SET IBDATA=$GET(^DGS(41.1,IBJ,0))

 +9                    SET DFN=+IBDATA

 +10      ;  no patient

                       IF 'DFN

                           QUIT 

 +11      ; canceled

                       IF $PIECE(IBDATA,"^",13)

                           QUIT 

 +12      ; already admitted

                       IF $PIECE(IBDATA,"^",17)

                           QUIT 

 +13      ;if not in ct add

 +14                   SET IBTRN=$ORDER(^IBT(356,"ASCH",IBJ,0))

 +15                   IF 'IBTRN

                           Begin DoDot:2

 +16                           IF $PIECE(IBTRKR,"^",2)=2

                                   DO SCH^IBTUTL2(DFN,IBI,IBJ)

                                   QUIT 

 +17                           IF $PIECE(IBTRKR,"^",2)=1

                                   IF $$INSURED^IBCNS1(DFN,+IBI)

                                       DO SCH^IBTUTL2(DFN,IBI,IBJ)

 +18                           QUIT 

                           End DoDot:2

                           QUIT 

 +19      ; -- if inactive re-activate

 +20                   IF '$PIECE(^IBT(356,+IBTRN,0),"^",20)

                           Begin DoDot:2

 +21                           NEW X,Y,I,J,DA,DR,DIE,DIC

 +22                           SET DA=IBTRN

                               SET DR=".2////1"

                               SET DIE="^IBT(356,"

                               DO ^DIE

                           End DoDot:2

 +23                   QUIT 

                   End DoDot:1

 +24      ;

ENQ        KILL IBTSEDT,IBTSBDT

 +1        QUIT 

 +2       ;

SCH(DGPMCA) ; -- is this admission movement a scheduled admission

 +1       ; -- output scheduled admission pointer

 +2       ;

 +3        NEW IBTSA

           SET IBTSA=0

 +4        IF '$GET(DGPMCA)

               GOTO SCHQ

 +5        SET IBTSA=+$ORDER(^DGS(41.1,"AMVT",DGPMCA,0))

SCHQ       QUIT IBTSA