IB20PT6 ;ALB/AAS - Insurance post init stuff ; 2/22/93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;
% S IBFORCE=1
I '$O(^IBA(355.3,0)) D ; -- one time updates (ins policy alerady exists
.D PAT ; x-ref patient file by ins. co., add hip pointer
.D 399^IB20PT61 ; add ae x-ref to file 399
.D INPT ; load current inpatients into claims tracking
;
K IBFORCE
Q
;
PAT ; -- create AB x-ref on patient file for all insurance co. pointers
W !!!,"<<< Patient file insurance conversion"
W !," Cross-reference patient file by Insurance company and",!," Update Health Insurance Policy Pointers"
S ZTRTN="PATDQ^IB20PT6",ZTDESC="IB - v2 PATIENT FILE POST INIT UPDATE",ZTIO="" S:$G(IBFORCE) ZTDTH=$$15
W ! D ^%ZTLOAD I '$D(ZTSK) D Q:'IBOK
.D MANUAL^IB20PT61
.I 'IBOK,$P($G(^IBE(350.9,1,3)),"^",18)="" W !!,"You must run the v2.0 post init routine IB20PT6 before allowing users to",!,"edit insurance information"
I $D(ZTSK) W !," Patient file update queued as task ",ZTSK K ZTSK Q
;
PATDQ D NOW^%DTC S IBSPDT=%
I '$D(ZTQUEUED) D
.W !!," I'll write a dot for each 100 entries"
.W !," Start time: " S Y=IBSPDT D DT^DIQ
N DFN,IBI,IBCPOL,IBCDFND,DA,DR,DIE,DIC,IBCNT,IBCNTP,IBCNTPP,IBCNTI
S (IBCNT,IBCNTP,IBCNTPP,IBCNTI,DFN)=0
F S DFN=$O(^DPT(DFN)) Q:'DFN S IBCNT=IBCNT+1,IBI=0 S:$O(^DPT(DFN,.312,IBI)) IBCNTI=IBCNTI+1 F S IBI=$O(^DPT(DFN,.312,IBI)) Q:'IBI D
.I '$D(ZTQUEUED) W:'(IBCNTPP#100) "."
.S IBCDFND=$G(^DPT(DFN,.312,IBI,0))
.S ^DPT("AB",+IBCDFND,DFN,IBI)=""
.S ^DPT(DFN,.312,"B",+IBCDFND,IBI)=""
.Q:$P(IBCDFND,U,18)
.S IBCPOL=$$CHIP^IBCNSU(IBCDFND)
.Q:'IBCPOL
.Q:+IBCDFND'=+$G(^IBA(355.3,+IBCPOL,0)) ; patient ins. and policy must have same ins. company file.
.S IBCNTPP=IBCNTPP+1
.S DA=IBI,DA(1)=DFN,DIE="^DPT("_DFN_",.312,"
.S DR="1.09////1;.18////"_IBCPOL
.D ^DIE K DA,DR,DIE,DIC
.Q
S $P(^IBE(350.9,1,3),"^",18)=DT
D NOW^%DTC S IBEPDT=%
D BULL1^IB20PT61
I '$D(ZTQUEUED) D
.W !!,"<<< Health Insurance Policy information updated"
.W !," there were ",IBCNTPP," Policies for ",IBCNT," Patients were updated"
.W !," causing ",IBCNTP," Health Insurance Policies to be added"
.W !," Finish Time: " S Y=IBEPDT D DT^DIQ
Q
;
;
INPT ; -- load current inpatients into claims tracking
W !!!,"<<< Load current inpatients into Claims Tracking"
S ZTRTN="INPTDQ^IB20PT6",ZTDESC="IB - v2 CLAIMS TRACKING POST INIT UPDATE",ZTIO="" S:$G(IBFORCE) ZTDTH=$$15
W ! D ^%ZTLOAD I '$D(ZTSK) D Q:'IBOK
.D MANUAL^IB20PT61
.I 'IBOK,$P($G(^IBE(350.9,1,3)),"^",20)="" W !!,"You must run the v2.0 post init routine IB20PT6 to automatically add",!,"Current inpatient into Claims Tracking."
I $D(ZTSK) W !," Claims Tracking update queued as task ",ZTSK K ZTSK Q
;
INPTDQ D NOW^%DTC S IBSTDT=%
N WARD,DGPMDA,IBCNT,IB20
S WARD="",DGPDMA=0,IBCNT=0,IB20=1
F S WARD=$O(^DGPM("CN",WARD)) Q:WARD="" S DGPMDA=0 F S DGPMDA=$O(^DGPM("CN",WARD,DGPMDA)) Q:'DGPMDA D
.S DGPMP=""
.S DGPMA=$G(^DGPM(DGPMDA,0)) Q:DGPMA=""
.S DFN=$P(DGPMA,"^",3) Q:'DFN
.D INP^VADPT
.K IBNEW D INP^IBTRKR
.I $G(IBNEW) S IBCNT=IBCNT+1 I '$D(ZTQUEUED) W !," Patient ",$P(^DPT(DFN,0),U)," added to the Claims tracking module"
;
I '$D(ZTQUEUED) W !!,"<<< ",IBCNT," Patients added to the Claims Tracking Module"
D NOW^%DTC S IBETDT=%
D BULL3^IB20PT61
S $P(^IBE(350.9,1,3),"^",20)=DT
Q
;
15() ; -- Add 15 minutes to now and return in $h format
Q $P($H,",")_","_($P($H,",",2)+(15*60))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20PT6 3519 printed Sep 23, 2025@19:41:35 Page 2
IB20PT6 ;ALB/AAS - Insurance post init stuff ; 2/22/93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;
% SET IBFORCE=1
+1 ; -- one time updates (ins policy alerady exists
IF '$ORDER(^IBA(355.3,0))
Begin DoDot:1
+2 ; x-ref patient file by ins. co., add hip pointer
DO PAT
+3 ; add ae x-ref to file 399
DO 399^IB20PT61
+4 ; load current inpatients into claims tracking
DO INPT
End DoDot:1
+5 ;
+6 KILL IBFORCE
+7 QUIT
+8 ;
PAT ; -- create AB x-ref on patient file for all insurance co. pointers
+1 WRITE !!!,"<<< Patient file insurance conversion"
+2 WRITE !," Cross-reference patient file by Insurance company and",!," Update Health Insurance Policy Pointers"
+3 SET ZTRTN="PATDQ^IB20PT6"
SET ZTDESC="IB - v2 PATIENT FILE POST INIT UPDATE"
SET ZTIO=""
if $GET(IBFORCE)
SET ZTDTH=$$15
+4 WRITE !
DO ^%ZTLOAD
IF '$DATA(ZTSK)
Begin DoDot:1
+5 DO MANUAL^IB20PT61
+6 IF 'IBOK
IF $PIECE($GET(^IBE(350.9,1,3)),"^",18)=""
WRITE !!,"You must run the v2.0 post init routine IB20PT6 before allowing users to",!,"edit insurance information"
End DoDot:1
if 'IBOK
QUIT
+7 IF $DATA(ZTSK)
WRITE !," Patient file update queued as task ",ZTSK
KILL ZTSK
QUIT
+8 ;
PATDQ DO NOW^%DTC
SET IBSPDT=%
+1 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+2 WRITE !!," I'll write a dot for each 100 entries"
+3 WRITE !," Start time: "
SET Y=IBSPDT
DO DT^DIQ
End DoDot:1
+4 NEW DFN,IBI,IBCPOL,IBCDFND,DA,DR,DIE,DIC,IBCNT,IBCNTP,IBCNTPP,IBCNTI
+5 SET (IBCNT,IBCNTP,IBCNTPP,IBCNTI,DFN)=0
+6 FOR
SET DFN=$ORDER(^DPT(DFN))
if 'DFN
QUIT
SET IBCNT=IBCNT+1
SET IBI=0
if $ORDER(^DPT(DFN,.312,IBI))
SET IBCNTI=IBCNTI+1
FOR
SET IBI=$ORDER(^DPT(DFN,.312,IBI))
if 'IBI
QUIT
Begin DoDot:1
+7 IF '$DATA(ZTQUEUED)
if '(IBCNTPP#100)
WRITE "."
+8 SET IBCDFND=$GET(^DPT(DFN,.312,IBI,0))
+9 SET ^DPT("AB",+IBCDFND,DFN,IBI)=""
+10 SET ^DPT(DFN,.312,"B",+IBCDFND,IBI)=""
+11 if $PIECE(IBCDFND,U,18)
QUIT
+12 SET IBCPOL=$$CHIP^IBCNSU(IBCDFND)
+13 if 'IBCPOL
QUIT
+14 ; patient ins. and policy must have same ins. company file.
if +IBCDFND'=+$GET(^IBA(355.3,+IBCPOL,0))
QUIT
+15 SET IBCNTPP=IBCNTPP+1
+16 SET DA=IBI
SET DA(1)=DFN
SET DIE="^DPT("_DFN_",.312,"
+17 SET DR="1.09////1;.18////"_IBCPOL
+18 DO ^DIE
KILL DA,DR,DIE,DIC
+19 QUIT
End DoDot:1
+20 SET $PIECE(^IBE(350.9,1,3),"^",18)=DT
+21 DO NOW^%DTC
SET IBEPDT=%
+22 DO BULL1^IB20PT61
+23 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+24 WRITE !!,"<<< Health Insurance Policy information updated"
+25 WRITE !," there were ",IBCNTPP," Policies for ",IBCNT," Patients were updated"
+26 WRITE !," causing ",IBCNTP," Health Insurance Policies to be added"
+27 WRITE !," Finish Time: "
SET Y=IBEPDT
DO DT^DIQ
End DoDot:1
+28 QUIT
+29 ;
+30 ;
INPT ; -- load current inpatients into claims tracking
+1 WRITE !!!,"<<< Load current inpatients into Claims Tracking"
+2 SET ZTRTN="INPTDQ^IB20PT6"
SET ZTDESC="IB - v2 CLAIMS TRACKING POST INIT UPDATE"
SET ZTIO=""
if $GET(IBFORCE)
SET ZTDTH=$$15
+3 WRITE !
DO ^%ZTLOAD
IF '$DATA(ZTSK)
Begin DoDot:1
+4 DO MANUAL^IB20PT61
+5 IF 'IBOK
IF $PIECE($GET(^IBE(350.9,1,3)),"^",20)=""
WRITE !!,"You must run the v2.0 post init routine IB20PT6 to automatically add",!,"Current inpatient into Claims Tracking."
End DoDot:1
if 'IBOK
QUIT
+6 IF $DATA(ZTSK)
WRITE !," Claims Tracking update queued as task ",ZTSK
KILL ZTSK
QUIT
+7 ;
INPTDQ DO NOW^%DTC
SET IBSTDT=%
+1 NEW WARD,DGPMDA,IBCNT,IB20
+2 SET WARD=""
SET DGPDMA=0
SET IBCNT=0
SET IB20=1
+3 FOR
SET WARD=$ORDER(^DGPM("CN",WARD))
if WARD=""
QUIT
SET DGPMDA=0
FOR
SET DGPMDA=$ORDER(^DGPM("CN",WARD,DGPMDA))
if 'DGPMDA
QUIT
Begin DoDot:1
+4 SET DGPMP=""
+5 SET DGPMA=$GET(^DGPM(DGPMDA,0))
if DGPMA=""
QUIT
+6 SET DFN=$PIECE(DGPMA,"^",3)
if 'DFN
QUIT
+7 DO INP^VADPT
+8 KILL IBNEW
DO INP^IBTRKR
+9 IF $GET(IBNEW)
SET IBCNT=IBCNT+1
IF '$DATA(ZTQUEUED)
WRITE !," Patient ",$PIECE(^DPT(DFN,0),U)," added to the Claims tracking module"
End DoDot:1
+10 ;
+11 IF '$DATA(ZTQUEUED)
WRITE !!,"<<< ",IBCNT," Patients added to the Claims Tracking Module"
+12 DO NOW^%DTC
SET IBETDT=%
+13 DO BULL3^IB20PT61
+14 SET $PIECE(^IBE(350.9,1,3),"^",20)=DT
+15 QUIT
+16 ;
15() ; -- Add 15 minutes to now and return in $h format
+1 QUIT $PIECE($HOROLOG,",")_","_($PIECE($HOROLOG,",",2)+(15*60))
