- 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 Jan 18, 2025@03:29:57 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