IBTRKRU ;WAS/RFJ - claims tracking file utilities ; 07 Feb 96
;;Version 2.0 ; INTEGRATED BILLING ;**56,62**; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
INACTIVE(DA) ; inactivate record in ct, delete admission field if
; entry in file 405 is deleted
N %,D,D0,DATA,DI,DIC,DIE,DIG,DIH,DIU,DIV,DQ,DR,X
S DATA=$G(^IBT(356,DA,0)) I DATA="" Q
; entry inactive (.2 field equal 0) and adm ptr removed (.05 deleted)
S DR=".2////0;.05///@;.32///@"
S DIE="^IBT(356,"
D ^DIE
Q
;
;
RELINK(DA,ADMPTR,EPISDATE) ; relink a deleted admission
; admptr = admission pointer to file 405
; episdate = episode date
N %,D,D0,DI,DIC,DIE,DIG,DIH,DIU,DIV,DQ,DR,X
S DR=".05////"_ADMPTR_";.06////"_EPISDATE_";.2////1"
S DIE="^IBT(356,"
D ^DIE
Q
;
;
DELETE(FILE,DA) ; delete entry da from file
N %,DIC,DIK,X,Y
I '$D(^IBT(FILE,DA,0)) Q
S DIK="^IBT("_FILE_","
D ^DIK
Q
;
;
; add comments field 11 for entry da
I $G(^IBT(FILE,DA,0))="" Q
N %,D,D0,DI,DIC,DIE,DIG,DIH,DIU,DIV,DQ,DR,J,X
S DR="11///Entry created by major change in specialty."
S DIE="^IBT("_FILE_","
D ^DIE
Q
;
;
INQUIRE(FILE,DA) ; return inquire data for file and entry da
K IBDATA(FILE,DA_",")
D GETS^DIQ(FILE,DA,"**","R","IBDATA")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRKRU 1401 printed Oct 16, 2024@18:29:23 Page 2
IBTRKRU ;WAS/RFJ - claims tracking file utilities ; 07 Feb 96
+1 ;;Version 2.0 ; INTEGRATED BILLING ;**56,62**; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
INACTIVE(DA) ; inactivate record in ct, delete admission field if
+1 ; entry in file 405 is deleted
+2 NEW %,D,D0,DATA,DI,DIC,DIE,DIG,DIH,DIU,DIV,DQ,DR,X
+3 SET DATA=$GET(^IBT(356,DA,0))
IF DATA=""
QUIT
+4 ; entry inactive (.2 field equal 0) and adm ptr removed (.05 deleted)
+5 SET DR=".2////0;.05///@;.32///@"
+6 SET DIE="^IBT(356,"
+7 DO ^DIE
+8 QUIT
+9 ;
+10 ;
RELINK(DA,ADMPTR,EPISDATE) ; relink a deleted admission
+1 ; admptr = admission pointer to file 405
+2 ; episdate = episode date
+3 NEW %,D,D0,DI,DIC,DIE,DIG,DIH,DIU,DIV,DQ,DR,X
+4 SET DR=".05////"_ADMPTR_";.06////"_EPISDATE_";.2////1"
+5 SET DIE="^IBT(356,"
+6 DO ^DIE
+7 QUIT
+8 ;
+9 ;
DELETE(FILE,DA) ; delete entry da from file
+1 NEW %,DIC,DIK,X,Y
+2 IF '$DATA(^IBT(FILE,DA,0))
QUIT
+3 SET DIK="^IBT("_FILE_","
+4 DO ^DIK
+5 QUIT
+6 ;
+7 ;
+1 ; add comments field 11 for entry da
+2 IF $GET(^IBT(FILE,DA,0))=""
QUIT
+3 NEW %,D,D0,DI,DIC,DIE,DIG,DIH,DIU,DIV,DQ,DR,J,X
+4 SET DR="11///Entry created by major change in specialty."
+5 SET DIE="^IBT("_FILE_","
+6 DO ^DIE
+7 QUIT
+8 ;
+9 ;
INQUIRE(FILE,DA) ; return inquire data for file and entry da
+1 KILL IBDATA(FILE,DA_",")
+2 DO GETS^DIQ(FILE,DA,"**","R","IBDATA")
+3 QUIT
