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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTUTL2 2189 printed Dec 13, 2024@02:29:15 Page 2
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
