IB20PT1 ;ALB/AAS/NLR - Insurance post init stuff ; 2/22/93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;
% I '$O(^IBA(355.3,0)) D ; -- one time updates (ins policy alerady exists
.D MAIL ; add new mail group
.D SITE ; update site paramters
.D DEL ; delete obsolete field in patient file ins. multiple
.;D PAT ; x-ref patient file by ins. co., add hip pointer
.D INS ; delete data, them dd for ins. address multiple in 36
.;D 399 ; add ae x-ref to file 399
.;D INPT ; load current inpatients into claims tracking
.D ^IB20PT6 ; que off patient file, bill/claims file, CT updates
;
Q
;
DEL ; -- delete insurance address field from insurance type multiple
N DA,DIK,DIU,DIC
Q:'$D(^DD(2.312,5,0))
S DA=5,DA(1)=2.312,DIK="^DD("_DA(1)_"," D ^DIK
W !!,"<<< Deleting Obsolete field *INSURANCE ADDRESS from Patient File Data Dictionary"
DELQ K DA,DIK,DIU
Q
;
INS ; -- delete address subfile
; first delete the data
N DIC,DIE,DA,DR,DIK,DIU
Q:'$D(^DD(36.02,0))
W !!,"<<< Deleting Obsolete *ADDRESS data from Insurance Company Entries"
W !!," I'll write a dot for each 100 entries"
S IBD0=0
F S IBD0=$O(^DIC(36,IBD0)) Q:'IBD0 S IBD1=0 F S IBD1=$O(^DIC(36,IBD0,2,IBD1)) Q:'IBD1 D K ^DIC(36,IBD0,2)
.S DIK="^DIC(36,"_IBD0_",2,",DA=IBD1,DA(1)=IBD0
.D ^DIK
.K DA,DIC,DIK
.S IBCNT=$G(IBCNT)+1
.W:'(IBCNT#100) "."
.Q
;
; -- Now delete the dd
S DIU=36.02,DIU(0)="S" D EN^DIU2
W !!,"<<< Deleting Obsolete subfile *ADDRESS from Insurance Company File Data Dictionary"
INSQ K DIU
Q
;
PAT ; -- create AB x-ref on patient file for all insurance co. pointers
W !!,"<<< Cross-referencing patient file by Insurance company and",!," Updating Health Insurance Policy Pointers"
W !!," I'll write a dot for each 100 entries"
D NOW^%DTC W !," Start time: " S Y=% D DT^DIQ
N DFN,IBI,IBCPOL,IBCDFND,DA,DR,DIE,DIC,IBCNT,IBCNTP,IBCNTPP
S (IBCNT,IBCNTP,IBCNTPP,DFN)=0
F S DFN=$O(^DPT(DFN)) Q:'DFN S IBCNT=IBCNT+1,IBI=0 F S IBI=$O(^DPT(DFN,.312,IBI)) Q:'IBI D
.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
.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
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"
D NOW^%DTC W !," Finish Time: " S Y=% D DT^DIQ
Q
;
399 ; -- create new AE x-ref of file 399
N IBCIFN,IBCNT
W !!,"<<< Cross-referencing Bill/Claims file by Primary Insurer"
W !!," I'll write a dot for each 100 entries"
S IBCIFN=0,IBCNT=0
F S IBCIFN=$O(^DGCR(399,IBCIFN)) Q:'IBCIFN D
.I +$G(^DGCR(399,IBCIFN,"M")),$P($G(^(0)),"^",2) S ^DGCR(399,"AE",$P(^(0),"^",2),+^("M"),IBCIFN)=""
.S IBCNT=$G(IBCNT)+1 W:'(IBCNT#100) "."
Q
;
INPT ; -- load current inpatients into claims tracking
W !!,"<<< Loading current inpatients into Claims Tracking"
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))
.S DFN=$P(DGPMA,"^",3)
.D INP^VADPT
.K IBNEW D INP^IBTRKR
.I $G(IBNEW) S IBCNT=IBCNT+1 W !," Patient ",$P(^DPT(DFN,0),U)," added to the Claims tracking module"
;
W !!,"<<< ",IBCNT," Patients added to the Claims Tracking Module"
Q
;
MAIL ; -- add new mail group
;Q:$D(^XMB(3.8,"B","IB NEW INSURANCE"))
S DLAYGO=3.8,DIC="^XMB(3.8,",DIC(0)="LX",DIC("DR")="4////PU;5////"_DUZ,X="IB NEW INSURANCE" D ^DIC K DIC I +Y>0 S IBCNMAIL=+Y
S ^XMB(3.8,+Y,2,0)="^^1^1^2900625^"
S ^XMB(3.8,+Y,2,1,0)="This mail group will receive notification whenever a new insurance policy is added."
W !!,"<<< Mail Group 'IB NEW INSURANCE' ",$S($P(Y,"^",3):"added...",1:"updated...")
W !!," Remember to add Members to this group"
Q
;
SITE ; -- setup ib site parameters
N DIE,DA,DR,DIC,DD,DO S DR=""
W !!,"<<< Updating new site parameters automatically!"
;
; -- if no entry add one
I '$D(^IBE(350.9,1,0)) S (X,DINUM)=1,DIC="^IBE(350.9,",DIC(0)="L" K DD,DO D FILE^DICN K DIC S DR=".03///1;.02////^S X=+$$SITE^VASITE;.08///2;.09///IB ERROR;",DA=1,DIE="^IBE(350.9," D ^DIE K DR,DA,DIE,DIC
;
S DA=1,DIE="^IBE(350.9,"
S DR="4.01////1;4.04////"_$G(IBCNMAIL)_";6.01///^S X=DT;6.02////1;6.02////1;6.03////1;6.04////1;6.05////1;6.06////1;6.07///^S X=DT;6.08////1;6.09////5;6.13////1;6.14////5;6.18////1;6.19////1"
D ^DIE K DIE,DA,DR,DIC,DD,DO W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20PT1 4792 printed Apr 09, 2024@21:05:03 Page 2
IB20PT1 ;ALB/AAS/NLR - Insurance post init stuff ; 2/22/93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;
% ; -- one time updates (ins policy alerady exists
IF '$ORDER(^IBA(355.3,0))
Begin DoDot:1
+1 ; add new mail group
DO MAIL
+2 ; update site paramters
DO SITE
+3 ; delete obsolete field in patient file ins. multiple
DO DEL
+4 ;D PAT ; x-ref patient file by ins. co., add hip pointer
+5 ; delete data, them dd for ins. address multiple in 36
DO INS
+6 ;D 399 ; add ae x-ref to file 399
+7 ;D INPT ; load current inpatients into claims tracking
+8 ; que off patient file, bill/claims file, CT updates
DO ^IB20PT6
End DoDot:1
+9 ;
+10 QUIT
+11 ;
DEL ; -- delete insurance address field from insurance type multiple
+1 NEW DA,DIK,DIU,DIC
+2 if '$DATA(^DD(2.312,5,0))
QUIT
+3 SET DA=5
SET DA(1)=2.312
SET DIK="^DD("_DA(1)_","
DO ^DIK
+4 WRITE !!,"<<< Deleting Obsolete field *INSURANCE ADDRESS from Patient File Data Dictionary"
DELQ KILL DA,DIK,DIU
+1 QUIT
+2 ;
INS ; -- delete address subfile
+1 ; first delete the data
+2 NEW DIC,DIE,DA,DR,DIK,DIU
+3 if '$DATA(^DD(36.02,0))
QUIT
+4 WRITE !!,"<<< Deleting Obsolete *ADDRESS data from Insurance Company Entries"
+5 WRITE !!," I'll write a dot for each 100 entries"
+6 SET IBD0=0
+7 FOR
SET IBD0=$ORDER(^DIC(36,IBD0))
if 'IBD0
QUIT
SET IBD1=0
FOR
SET IBD1=$ORDER(^DIC(36,IBD0,2,IBD1))
if 'IBD1
QUIT
Begin DoDot:1
+8 SET DIK="^DIC(36,"_IBD0_",2,"
SET DA=IBD1
SET DA(1)=IBD0
+9 DO ^DIK
+10 KILL DA,DIC,DIK
+11 SET IBCNT=$GET(IBCNT)+1
+12 if '(IBCNT#100)
WRITE "."
+13 QUIT
End DoDot:1
KILL ^DIC(36,IBD0,2)
+14 ;
+15 ; -- Now delete the dd
+16 SET DIU=36.02
SET DIU(0)="S"
DO EN^DIU2
+17 WRITE !!,"<<< Deleting Obsolete subfile *ADDRESS from Insurance Company File Data Dictionary"
INSQ KILL DIU
+1 QUIT
+2 ;
PAT ; -- create AB x-ref on patient file for all insurance co. pointers
+1 WRITE !!,"<<< Cross-referencing patient file by Insurance company and",!," Updating Health Insurance Policy Pointers"
+2 WRITE !!," I'll write a dot for each 100 entries"
+3 DO NOW^%DTC
WRITE !," Start time: "
SET Y=%
DO DT^DIQ
+4 NEW DFN,IBI,IBCPOL,IBCDFND,DA,DR,DIE,DIC,IBCNT,IBCNTP,IBCNTPP
+5 SET (IBCNT,IBCNTP,IBCNTPP,DFN)=0
+6 FOR
SET DFN=$ORDER(^DPT(DFN))
if 'DFN
QUIT
SET IBCNT=IBCNT+1
SET IBI=0
FOR
SET IBI=$ORDER(^DPT(DFN,.312,IBI))
if 'IBI
QUIT
Begin DoDot:1
+7 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 SET IBCNTPP=IBCNTPP+1
+15 SET DA=IBI
SET DA(1)=DFN
SET DIE="^DPT("_DFN_",.312,"
+16 SET DR="1.09////1;.18////"_IBCPOL
+17 DO ^DIE
KILL DA,DR,DIE,DIC
+18 QUIT
End DoDot:1
+19 WRITE !!,"<<< Health Insurance Policy information updated"
+20 WRITE !," there were ",IBCNTPP," Policies for ",IBCNT," Patients were updated"
+21 WRITE !," causing ",IBCNTP," Health Insurance Policies to be added"
+22 DO NOW^%DTC
WRITE !," Finish Time: "
SET Y=%
DO DT^DIQ
+23 QUIT
+24 ;
399 ; -- create new AE x-ref of file 399
+1 NEW IBCIFN,IBCNT
+2 WRITE !!,"<<< Cross-referencing Bill/Claims file by Primary Insurer"
+3 WRITE !!," I'll write a dot for each 100 entries"
+4 SET IBCIFN=0
SET IBCNT=0
+5 FOR
SET IBCIFN=$ORDER(^DGCR(399,IBCIFN))
if 'IBCIFN
QUIT
Begin DoDot:1
+6 IF +$GET(^DGCR(399,IBCIFN,"M"))
IF $PIECE($GET(^(0)),"^",2)
SET ^DGCR(399,"AE",$PIECE(^(0),"^",2),+^("M"),IBCIFN)=""
+7 SET IBCNT=$GET(IBCNT)+1
if '(IBCNT#100)
WRITE "."
End DoDot:1
+8 QUIT
+9 ;
INPT ; -- load current inpatients into claims tracking
+1 WRITE !!,"<<< Loading current inpatients into Claims Tracking"
+2 NEW WARD,DGPMDA,IBCNT,IB20
+3 SET WARD=""
SET DGPDMA=0
SET IBCNT=0
SET IB20=1
+4 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
+5 SET DGPMP=""
+6 SET DGPMA=$GET(^DGPM(DGPMDA,0))
+7 SET DFN=$PIECE(DGPMA,"^",3)
+8 DO INP^VADPT
+9 KILL IBNEW
DO INP^IBTRKR
+10 IF $GET(IBNEW)
SET IBCNT=IBCNT+1
WRITE !," Patient ",$PIECE(^DPT(DFN,0),U)," added to the Claims tracking module"
End DoDot:1
+11 ;
+12 WRITE !!,"<<< ",IBCNT," Patients added to the Claims Tracking Module"
+13 QUIT
+14 ;
MAIL ; -- add new mail group
+1 ;Q:$D(^XMB(3.8,"B","IB NEW INSURANCE"))
+2 SET DLAYGO=3.8
SET DIC="^XMB(3.8,"
SET DIC(0)="LX"
SET DIC("DR")="4////PU;5////"_DUZ
SET X="IB NEW INSURANCE"
DO ^DIC
KILL DIC
IF +Y>0
SET IBCNMAIL=+Y
+3 SET ^XMB(3.8,+Y,2,0)="^^1^1^2900625^"
+4 SET ^XMB(3.8,+Y,2,1,0)="This mail group will receive notification whenever a new insurance policy is added."
+5 WRITE !!,"<<< Mail Group 'IB NEW INSURANCE' ",$SELECT($PIECE(Y,"^",3):"added...",1:"updated...")
+6 WRITE !!," Remember to add Members to this group"
+7 QUIT
+8 ;
SITE ; -- setup ib site parameters
+1 NEW DIE,DA,DR,DIC,DD,DO
SET DR=""
+2 WRITE !!,"<<< Updating new site parameters automatically!"
+3 ;
+4 ; -- if no entry add one
+5 IF '$DATA(^IBE(350.9,1,0))
SET (X,DINUM)=1
SET DIC="^IBE(350.9,"
SET DIC(0)="L"
KILL DD,DO
DO FILE^DICN
KILL DIC
SET DR=".03///1;.02////^S X=+$$SITE^VASITE;.08///2;.09///IB ERROR;"
SET DA=1
SET DIE="^IBE(350.9,"
DO ^DIE
KILL DR,DA,DIE,DIC
+6 ;
+7 SET DA=1
SET DIE="^IBE(350.9,"
+8 SET DR="4.01////1;4.04////"_$GET(IBCNMAIL)_";6.01///^S X=DT;6.02////1;6.02////1;6.03////1;6.04////1;6.05////1;6.06////1;6.07///^S X=DT;6.08////1;6.09////5;6.13////1;6.14////5;6.18////1;6.19////1"
+9 DO ^DIE
KILL DIE,DA,DR,DIC,DD,DO
WRITE !
+10 QUIT
