IBTRKRBD ;WAS/RFJ - claims tracking - deleted admission bulletin ; 1 Mar 96
;;Version 2.0 ; INTEGRATED BILLING ;**56**; 21-MAR-94
;
DELBULL(DFN,IBTRN,DGPMA,IBSPEC) ; -- send deleted admission bulletin
; dfn = patient ien file 2
; ibtrn = claims tracking ien file 356
; dgpma = 0th node from movement file 405
; ibspec = specialty ien file 45.7
N %,DA,FILE,HDRFLAG,IBT,IBTDATE,LINE,SERVICE,SPECALTY,VA,VAERR,Y
S IBT(1)="The following claims tracking patient's admission has been deleted from the"
S IBT(2)="movement file (405). The patient's entry in the claims tracking file (356)"
S IBT(3)="has been set to inactive. If the same patient is admitted to the hospital"
S IBT(4)="with an admission date 5 days before or after the original admission date"
S IBT(5)="the patient's entry in the claims tracking file (356) will be reactivated."
S IBT(6)=""
;
D PID^VADPT
S IBT(7)=" Patient: "_$P(^DPT(DFN,0),"^")_" ("_VA("PID")_")"
S IBT(8)=" Claims Tracking Entry: "_IBTRN
S IBT(9)=" Claims Tracking ID: "_$P($G(^IBT(356,+IBTRN,0)),"^")
;
S Y=$P(DGPMA,"^") D DD^%DT
S IBT(10)="Original Admission Date: "_Y_" ("_$P(DGPMA,"^",14)_")"
S IBT(11)=""
;
S IBT(12)=" =============== ADMISSION DATA ==============="
S SPECALTY=$P($G(^DIC(45.7,+IBSPEC,0)),"^",2)
S IBT(13)=" Specialty: "_$P($G(^DIC(45.7,+IBSPEC,0)),"^")
;
S SERVICE=$P($G(^DIC(42.4,+$P($G(^DIC(45.7,+IBSPEC,0)),"^",2),0)),"^",3)
S IBT(14)=" Service: "_$$EXPAND^IBTRE(42.4,3,SERVICE)
S IBT(15)=" Ward Location: "_$S($D(^DIC(42,+$P(DGPMA,"^",6),0)):$P(^(0),"^",1),1:"UNKNOWN")
S IBT(16)=" Room-Bed: "_$S($D(^DG(405.4,+$P(DGPMA,"^",7),0)):$P(^(0),"^",1),1:"UNKNOWN")
S IBT(17)=" Admitting DX: "_$P(DGPMA,"^",10)
S IBT(18)=" Type of Admit: "_$S($D(^DG(405.1,+$P(DGPMA,"^",4),0)):$P(^(0),"^",1),1:"")
S IBT(19)=" Insured: "_$S($$INSURED^IBCNS1(DFN):"YES",1:"NO")
;
S LINE=19
;
F FILE=356.1,356.2 S (DA,HDRFLAG)=0 F S DA=$O(^IBT(FILE,"C",+IBTRN,DA)) Q:'DA D BUILD
;
F FILE=356.9,356.91,356.94 S (DA,HDRFLAG)=0 F S DA=$O(^IBT(FILE,"C",+$P(DGPMA,"^",14),DA)) Q:'DA D BUILD
;
S FILE=356.93,(IBTDATE,HDRFLAG)=0 F S IBTDATE=$O(^IBT(FILE,"AMVD",+$P(DGPMA,"^",14),IBTDATE)) Q:'IBTDATE S DA=0 F S DA=$O(^IBT(FILE,"AMVD",+$P(DGPMA,"^",14),IBTDATE,DA)) Q:'DA D BUILD
;
; send the bulletin
D SEND^IBTRKRBA("UR Claims Tracking Admission Deleted")
Q
;
;
BUILD ; build data for file and entry
N FIELD,HDRDATA,IBDATA
D INQUIRE^IBTRKRU(FILE,DA)
I '$D(IBDATA) Q
;
; store file name in msg (once for each file)
I 'HDRFLAG S HDRFLAG=1 D FILE^DID(FILE,"","NAME","HDRDATA"),SET(" "),SET(" =============== "_$G(HDRDATA("NAME"))_" DATA (FILE "_FILE_") ===============")
;
D SET($J("ENTRY NUMBER",35)_": "_DA)
;
; do not show adm. movement field (pts to deleted 405 entry)
S FIELD="" F S FIELD=$O(IBDATA(FILE,DA_",",FIELD)) Q:FIELD="" I FIELD'="ADMISSION MOVEMENT",IBDATA(FILE,DA_",",FIELD)'="" D SET($J(FIELD,35)_": "_IBDATA(FILE,DA_",",FIELD))
D SET(" ")
Q
;
;
SET(MSG) ; set message text
S LINE=LINE+1,IBT(LINE)=MSG
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRKRBD 3155 printed Sep 23, 2025@20:05:06 Page 2
IBTRKRBD ;WAS/RFJ - claims tracking - deleted admission bulletin ; 1 Mar 96
+1 ;;Version 2.0 ; INTEGRATED BILLING ;**56**; 21-MAR-94
+2 ;
DELBULL(DFN,IBTRN,DGPMA,IBSPEC) ; -- send deleted admission bulletin
+1 ; dfn = patient ien file 2
+2 ; ibtrn = claims tracking ien file 356
+3 ; dgpma = 0th node from movement file 405
+4 ; ibspec = specialty ien file 45.7
+5 NEW %,DA,FILE,HDRFLAG,IBT,IBTDATE,LINE,SERVICE,SPECALTY,VA,VAERR,Y
+6 SET IBT(1)="The following claims tracking patient's admission has been deleted from the"
+7 SET IBT(2)="movement file (405). The patient's entry in the claims tracking file (356)"
+8 SET IBT(3)="has been set to inactive. If the same patient is admitted to the hospital"
+9 SET IBT(4)="with an admission date 5 days before or after the original admission date"
+10 SET IBT(5)="the patient's entry in the claims tracking file (356) will be reactivated."
+11 SET IBT(6)=""
+12 ;
+13 DO PID^VADPT
+14 SET IBT(7)=" Patient: "_$PIECE(^DPT(DFN,0),"^")_" ("_VA("PID")_")"
+15 SET IBT(8)=" Claims Tracking Entry: "_IBTRN
+16 SET IBT(9)=" Claims Tracking ID: "_$PIECE($GET(^IBT(356,+IBTRN,0)),"^")
+17 ;
+18 SET Y=$PIECE(DGPMA,"^")
DO DD^%DT
+19 SET IBT(10)="Original Admission Date: "_Y_" ("_$PIECE(DGPMA,"^",14)_")"
+20 SET IBT(11)=""
+21 ;
+22 SET IBT(12)=" =============== ADMISSION DATA ==============="
+23 SET SPECALTY=$PIECE($GET(^DIC(45.7,+IBSPEC,0)),"^",2)
+24 SET IBT(13)=" Specialty: "_$PIECE($GET(^DIC(45.7,+IBSPEC,0)),"^")
+25 ;
+26 SET SERVICE=$PIECE($GET(^DIC(42.4,+$PIECE($GET(^DIC(45.7,+IBSPEC,0)),"^",2),0)),"^",3)
+27 SET IBT(14)=" Service: "_$$EXPAND^IBTRE(42.4,3,SERVICE)
+28 SET IBT(15)=" Ward Location: "_$SELECT($DATA(^DIC(42,+$PIECE(DGPMA,"^",6),0)):$PIECE(^(0),"^",1),1:"UNKNOWN")
+29 SET IBT(16)=" Room-Bed: "_$SELECT($DATA(^DG(405.4,+$PIECE(DGPMA,"^",7),0)):$PIECE(^(0),"^",1),1:"UNKNOWN")
+30 SET IBT(17)=" Admitting DX: "_$PIECE(DGPMA,"^",10)
+31 SET IBT(18)=" Type of Admit: "_$SELECT($DATA(^DG(405.1,+$PIECE(DGPMA,"^",4),0)):$PIECE(^(0),"^",1),1:"")
+32 SET IBT(19)=" Insured: "_$SELECT($$INSURED^IBCNS1(DFN):"YES",1:"NO")
+33 ;
+34 SET LINE=19
+35 ;
+36 FOR FILE=356.1,356.2
SET (DA,HDRFLAG)=0
FOR
SET DA=$ORDER(^IBT(FILE,"C",+IBTRN,DA))
if 'DA
QUIT
DO BUILD
+37 ;
+38 FOR FILE=356.9,356.91,356.94
SET (DA,HDRFLAG)=0
FOR
SET DA=$ORDER(^IBT(FILE,"C",+$PIECE(DGPMA,"^",14),DA))
if 'DA
QUIT
DO BUILD
+39 ;
+40 SET FILE=356.93
SET (IBTDATE,HDRFLAG)=0
FOR
SET IBTDATE=$ORDER(^IBT(FILE,"AMVD",+$PIECE(DGPMA,"^",14),IBTDATE))
if 'IBTDATE
QUIT
SET DA=0
FOR
SET DA=$ORDER(^IBT(FILE,"AMVD",+$PIECE(DGPMA,"^",14),IBTDATE,DA))
if 'DA
QUIT
DO BUILD
+41 ;
+42 ; send the bulletin
+43 DO SEND^IBTRKRBA("UR Claims Tracking Admission Deleted")
+44 QUIT
+45 ;
+46 ;
BUILD ; build data for file and entry
+1 NEW FIELD,HDRDATA,IBDATA
+2 DO INQUIRE^IBTRKRU(FILE,DA)
+3 IF '$DATA(IBDATA)
QUIT
+4 ;
+5 ; store file name in msg (once for each file)
+6 IF 'HDRFLAG
SET HDRFLAG=1
DO FILE^DID(FILE,"","NAME","HDRDATA")
DO SET(" ")
DO SET(" =============== "_$GET(HDRDATA("NAME"))_" DATA (FILE "_FILE_") ===============")
+7 ;
+8 DO SET($JUSTIFY("ENTRY NUMBER",35)_": "_DA)
+9 ;
+10 ; do not show adm. movement field (pts to deleted 405 entry)
+11 SET FIELD=""
FOR
SET FIELD=$ORDER(IBDATA(FILE,DA_",",FIELD))
if FIELD=""
QUIT
IF FIELD'="ADMISSION MOVEMENT"
IF IBDATA(FILE,DA_",",FIELD)'=""
DO SET($JUSTIFY(FIELD,35)_": "_IBDATA(FILE,DA_",",FIELD))
+12 DO SET(" ")
+13 QUIT
+14 ;
+15 ;
SET(MSG) ; set message text
+1 SET LINE=LINE+1
SET IBT(LINE)=MSG
+2 QUIT
