IBTUTL2.m

IBTUTL2	;ALB/AAS - CLAIMS TRACKING UTILITY ROUTINE ; 21-JUN-93

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

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

	;

ADDR(IBTRVDT,IBTRN)	; -- add new entry to reviews file, ibt(356.1

	; -- Input  IBTRVDT :=  Review date (in internal fileman format)

	;             IBTRN :=  pointer to tracking module

	;

	N %DT,DD,DO,DIC,DR,DIE,DLAYGO

	S DIC="^IBT(356.1,",DIC(0)="L",DLAYGO=356.1

	S DIC("DR")=".02////"_IBTRN

	S X=IBTRVDT D FILE^DICN

	S IBTRV=+Y,IBNEW=1

ADDRQ	Q

	;

PRE(IBTRVDT,IBTRN,IBX)	; -- add a  review

	; -- Input  IBTRVDT :=  Review date (in internal fileman format)

	;             IBTRN :=  pointer to tracking module

	;               IBX :=  code for review

	;

	N X,Y,DA,DR,DIE,DIC,IBXIFN,IBNRVDT,IBDAYS

	D ADDR(IBTRVDT,IBTRN)

	I IBTRV<1 G PREQ

	;

	; -- don't differentiate between scheduled and unscheduled

	I IBX=10!(IBX=20) S IBX=15 ; just admission review

	;

	S IBDAYS=$S(IBX=15:1,1:$$RDAY^IBTRV31(IBTRN))

	S:'$G(IBX) IBX=30 S IBXIFN=$O(^IBE(356.11,"ACODE",IBX,0))

	;S X1=IBTRVDT,X2=$S(IBX=15:3,1:"") I X2 D C^%DTC S IBNRVDT=X

	S DA=IBTRV,DIE="^IBT(356.1,"

	L +^IBT(356.1,+IBTRV):10 I '$T G PREQ

	S DR=".19////1;.03////^S X=$G(IBDAYS);.2////^S X=$$NXTRVDT^IBTRV31(IBTRV);.21////1;.22////"_IBXIFN_";1.01///NOW;1.02////"_DUZ

	D ^DIE K DA,DR,DIE

	L -^IBT(356.1,+IBTRV)

PREQ	Q

	;

SCH(DFN,IBTDT,IBSCH)	; -- add scheduled admission entries

	; -- input   dfn  := patient pointer to 2

	;          ibtdt  := episode date

	;

	N X,Y,DA,DR,DIE,DIC

	;S IBETYP=+$O(^IBE(356.6,"B","SCHEDULED ADMISSION",0))

	S IBETYP=+$O(^IBE(356.6,"AC",5,0)) ;scheduled admission type

	S X=$O(^IBT(356,"APTY",DFN,IBETYP,IBTDT,0)) I X S IBTRN=X G SCHQ

	D ADDT^IBTUTL

	I IBTRN<1 G SCHQ

	S DA=IBTRN,DIE="^IBT(356,"

	I '$G(IBSCH) S X=0 F  S X=$O(^DGS(41.1,"B",DFN,X)) Q:'X  I $P(^DGS(41.1,+X,0),"^",2)=IBTDT S IBSCH=X Q

	L +^IBT(356,+IBTRN):5 I '$T G SCHQ

	S DR=$$ADMDR^IBTUTL(IBTDT,IBETYP,"",0)

	I $G(IBSCH) S DR=DR_";.32////"_IBSCH

	D ^DIE K DA,DR,DIE

	L -^IBT(356,+IBTRN)

	;

	; -- add required ins. action if insured

	I $P(^IBT(356,IBTRN,0),U,24) D COM^IBTUTL3(IBTDT,IBTRN,10)

SCHQ	Q

IBTUTL2   ;ALB/AAS - CLAIMS TRACKING UTILITY ROUTINE ; 21-JUN-93

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

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

 +3       ;

ADDR(IBTRVDT,IBTRN) ; -- add new entry to reviews file, ibt(356.1

 +1       ; -- Input  IBTRVDT :=  Review date (in internal fileman format)

 +2       ;             IBTRN :=  pointer to tracking module

 +3       ;

 +4        NEW %DT,DD,DO,DIC,DR,DIE,DLAYGO

 +5        SET DIC="^IBT(356.1,"

           SET DIC(0)="L"

           SET DLAYGO=356.1

 +6        SET DIC("DR")=".02////"_IBTRN

 +7        SET X=IBTRVDT

           DO FILE^DICN

 +8        SET IBTRV=+Y

           SET IBNEW=1

ADDRQ      QUIT 

 +1       ;

PRE(IBTRVDT,IBTRN,IBX) ; -- add a  review

 +1       ; -- Input  IBTRVDT :=  Review date (in internal fileman format)

 +2       ;             IBTRN :=  pointer to tracking module

 +3       ;               IBX :=  code for review

 +4       ;

 +5        NEW X,Y,DA,DR,DIE,DIC,IBXIFN,IBNRVDT,IBDAYS

 +6        DO ADDR(IBTRVDT,IBTRN)

 +7        IF IBTRV<1

               GOTO PREQ

 +8       ;

 +9       ; -- don't differentiate between scheduled and unscheduled

 +10      ; just admission review

           IF IBX=10!(IBX=20)

               SET IBX=15

 +11      ;

 +12       SET IBDAYS=$SELECT(IBX=15:1,1:$$RDAY^IBTRV31(IBTRN))

 +13       IF '$GET(IBX)

               SET IBX=30

           SET IBXIFN=$ORDER(^IBE(356.11,"ACODE",IBX,0))

 +14      ;S X1=IBTRVDT,X2=$S(IBX=15:3,1:"") I X2 D C^%DTC S IBNRVDT=X

 +15       SET DA=IBTRV

           SET DIE="^IBT(356.1,"

 +16       LOCK +^IBT(356.1,+IBTRV):10

           IF '$TEST

               GOTO PREQ

 +17       SET DR=".19////1;.03////^S X=$G(IBDAYS);.2////^S X=$$NXTRVDT^IBTRV31(IBTRV);.21////1;.22////"_IBXIFN_";1.01///NOW;1.02////"_DUZ

 +18       DO ^DIE

           KILL DA,DR,DIE

 +19       LOCK -^IBT(356.1,+IBTRV)

PREQ       QUIT 

 +1       ;

SCH(DFN,IBTDT,IBSCH) ; -- add scheduled admission entries

 +1       ; -- input   dfn  := patient pointer to 2

 +2       ;          ibtdt  := episode date

 +3       ;

 +4        NEW X,Y,DA,DR,DIE,DIC

 +5       ;S IBETYP=+$O(^IBE(356.6,"B","SCHEDULED ADMISSION",0))

 +6       ;scheduled admission type

           SET IBETYP=+$ORDER(^IBE(356.6,"AC",5,0))

 +7        SET X=$ORDER(^IBT(356,"APTY",DFN,IBETYP,IBTDT,0))

           IF X

               SET IBTRN=X

               GOTO SCHQ

 +8        DO ADDT^IBTUTL

 +9        IF IBTRN<1

               GOTO SCHQ

 +10       SET DA=IBTRN

           SET DIE="^IBT(356,"

 +11       IF '$GET(IBSCH)

               SET X=0

               FOR 

                   SET X=$ORDER(^DGS(41.1,"B",DFN,X))

                   IF 'X

                       QUIT 

                   IF $PIECE(^DGS(41.1,+X,0),"^",2)=IBTDT

                       SET IBSCH=X

                       QUIT 

 +12       LOCK +^IBT(356,+IBTRN):5

           IF '$TEST

               GOTO SCHQ

 +13       SET DR=$$ADMDR^IBTUTL(IBTDT,IBETYP,"",0)

 +14       IF $GET(IBSCH)

               SET DR=DR_";.32////"_IBSCH

 +15       DO ^DIE

           KILL DA,DR,DIE

 +16       LOCK -^IBT(356,+IBTRN)

 +17      ;

 +18      ; -- add required ins. action if insured

 +19       IF $PIECE(^IBT(356,IBTRN,0),U,24)

               DO COM^IBTUTL3(IBTDT,IBTRN,10)

SCHQ       QUIT