IBTRKRU.m

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

 ;

 ;

COMMENT(FILE,DA)    ;  hospital (file 356.1) or insurance (file 356.2) review

 ;  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 ---IBTRKRU   1401     printed  Apr 09, 2024@21:16                                                                                                                                                                                                        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       ;

COMMENT(FILE,DA) ;  hospital (file 356.1) or insurance (file 356.2) review

 +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