IBYQNS ;ALB/ARH - POST INIT FOR COB INSURANCE PATCH ; 5/1/97
;;2.0;INTEGRATED BILLING;**85**;21-MAR-94
;
POST ;
D RIDER ; add dental rider
D CV ; add dental and mental health coverage (cv)
D TOP ; inactivate Type of Plans
D MES^XPDUTL(" ")
Q
;
RIDER ; add Dental Insurance Rider (355.6)
N IBNAME,DD,DO,DLAYGO,DIC,X,Y,IBDA,IBARR,IBX
D MES^XPDUTL(" ")
;
S IBNAME="DENTAL COVERAGE"
I $O(^IBE(355.6,"B",IBNAME,0)) S IBX=" - "_IBNAME_" Insurance Rider (355.6) already exists, no change" D MES^XPDUTL(IBX) Q
;
K DD,DO S DLAYGO=355.6,DIC="^IBE(355.6,",DIC(0)="L",X=IBNAME D FILE^DICN K DIC I Y<1 K X,Y Q
S IBDA=+Y
;
S IBX=" * "_IBNAME_" Insurance Rider (355.6) added" D MES^XPDUTL(IBX)
Q
;
;
CV ; add Dental and Mental Health Coverage (355.31)
N IBNAME,IBRIDER,IBRDA,IBX,DD,DO,DLAYGO,DIC,X,Y,IBDA,DIE,DA,DR,IBFILE
D MES^XPDUTL(" ")
S IBFILE=" Plan Limitation Category (355.31) "
;
DNTL S IBNAME="DENTAL",IBRIDER="DENTAL COVERAGE"
S IBRDA=$O(^IBE(355.6,"B",IBRIDER,0)) I 'IBRDA S IBX=" - "_IBNAME_IBFILE_"Not Added, Rider Missing" D MES^XPDUTL(IBX) G MH
;
I $O(^IBE(355.31,"B",IBNAME,0)) S IBX=" - "_IBNAME_IBFILE_"already exists, no change" D MES^XPDUTL(IBX) G MH
;
K DD,DO S DLAYGO=355.31,DIC="^IBE(355.31,",DIC(0)="L",X=IBNAME D FILE^DICN K DIC I Y<1 K X,Y Q
S IBDA=+Y
;
S DIE="^IBE(355.31,",DA=+IBDA,DR=".02////Dental coverage;.03////"_IBRDA D ^DIE K DIE,DA,DR,X,Y
;
S IBX=" * "_IBNAME_IBFILE_"added" D MES^XPDUTL(IBX)
;
;
MH S IBNAME="MENTAL HEALTH",IBRIDER="MENTAL HEALTH COVERAGE"
S IBRDA=$O(^IBE(355.6,"B",IBRIDER,0)) I 'IBRDA S IBX=" - "_IBNAME_IBFILE_"Not Added, Rider Missing" D MES^XPDUTL(IBX) Q
;
I $O(^IBE(355.31,"B",IBNAME,0)) S IBX=" - "_IBNAME_IBFILE_"already exists, no change" D MES^XPDUTL(IBX) Q
;
K DD,DO S DLAYGO=355.31,DIC="^IBE(355.31,",DIC(0)="L",X=IBNAME D FILE^DICN K DIC I Y<1 K X,Y Q
S IBDA=+Y
;
S DIE="^IBE(355.31,",DA=+IBDA,DR=".02////Mental health coverage;.03////"_IBRDA D ^DIE K DIE,DA,DR,X,Y
;
S IBX=" * "_IBNAME_IBFILE_"added" D MES^XPDUTL(IBX)
;
Q
;
;
TOP ; inactivate Type of Plans (355.1)
N IBNAME,IBTOPFN,IBTOPEN,IBI,IBX,DD,DO,DLAYGO,DIC,X,Y,IBDA,DIE,DA,DR
D MES^XPDUTL(" ")
;
F IBI=1:1 S IBNAME=$P($T(TOPF+IBI),";;",2) Q:+IBNAME!(IBNAME="") D
. ;
. S IBTOPFN=$O(^IBE(355.1,"B",$E(IBNAME,1,30),0))
. I 'IBTOPFN S IBX=" - "_IBNAME_" Type of Plan (355.1) not defined, no change" D MES^XPDUTL(IBX) Q
. ;
. S IBTOPEN=$G(^IBE(355.1,IBTOPFN,0))
. I IBTOPEN="" S IBX=" - "_IBNAME_" Type of Plan (355.1) not found, no change" D MES^XPDUTL(IBX) Q
. ;
. I +$P(IBTOPEN,U,4) S IBX=" - "_IBNAME_" Type of Plan (355.1) inactive, no change" D MES^XPDUTL(IBX) Q
. ;
. ;
. S DIE="^IBE(355.1,",DA=+IBTOPFN,DR=".04////1" D ^DIE K DIE,DA,DR,X,Y
. S IBX=" * "_IBNAME_" Type of Plan (355.1) Inactivated" D MES^XPDUTL(IBX)
Q
;
TOPF ;
;;AVIATION TRIP INSURANCE
;;BLUE CROSS/BLUE SHIELD
;;COINSURANCE
;;DUAL COVERAGE
;;HOSPITAL-MEDICAL INSURANCE
;;KEY-MAN HEALTH INSURANCE
;;MAJOR MEDICAL EXPENSE INSURANCE
;;QUALIFIED IMPAIRMENT INSURANCE
;;REGULAR MEDICAL EXPENSE INSURANCE
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBYQNS 3186 printed Apr 09, 2024@21:04:24 Page 2
IBYQNS ;ALB/ARH - POST INIT FOR COB INSURANCE PATCH ; 5/1/97
+1 ;;2.0;INTEGRATED BILLING;**85**;21-MAR-94
+2 ;
POST ;
+1 ; add dental rider
DO RIDER
+2 ; add dental and mental health coverage (cv)
DO CV
+3 ; inactivate Type of Plans
DO TOP
+4 DO MES^XPDUTL(" ")
+5 QUIT
+6 ;
RIDER ; add Dental Insurance Rider (355.6)
+1 NEW IBNAME,DD,DO,DLAYGO,DIC,X,Y,IBDA,IBARR,IBX
+2 DO MES^XPDUTL(" ")
+3 ;
+4 SET IBNAME="DENTAL COVERAGE"
+5 IF $ORDER(^IBE(355.6,"B",IBNAME,0))
SET IBX=" - "_IBNAME_" Insurance Rider (355.6) already exists, no change"
DO MES^XPDUTL(IBX)
QUIT
+6 ;
+7 KILL DD,DO
SET DLAYGO=355.6
SET DIC="^IBE(355.6,"
SET DIC(0)="L"
SET X=IBNAME
DO FILE^DICN
KILL DIC
IF Y<1
KILL X,Y
QUIT
+8 SET IBDA=+Y
+9 ;
+10 SET IBX=" * "_IBNAME_" Insurance Rider (355.6) added"
DO MES^XPDUTL(IBX)
+11 QUIT
+12 ;
+13 ;
CV ; add Dental and Mental Health Coverage (355.31)
+1 NEW IBNAME,IBRIDER,IBRDA,IBX,DD,DO,DLAYGO,DIC,X,Y,IBDA,DIE,DA,DR,IBFILE
+2 DO MES^XPDUTL(" ")
+3 SET IBFILE=" Plan Limitation Category (355.31) "
+4 ;
DNTL SET IBNAME="DENTAL"
SET IBRIDER="DENTAL COVERAGE"
+1 SET IBRDA=$ORDER(^IBE(355.6,"B",IBRIDER,0))
IF 'IBRDA
SET IBX=" - "_IBNAME_IBFILE_"Not Added, Rider Missing"
DO MES^XPDUTL(IBX)
GOTO MH
+2 ;
+3 IF $ORDER(^IBE(355.31,"B",IBNAME,0))
SET IBX=" - "_IBNAME_IBFILE_"already exists, no change"
DO MES^XPDUTL(IBX)
GOTO MH
+4 ;
+5 KILL DD,DO
SET DLAYGO=355.31
SET DIC="^IBE(355.31,"
SET DIC(0)="L"
SET X=IBNAME
DO FILE^DICN
KILL DIC
IF Y<1
KILL X,Y
QUIT
+6 SET IBDA=+Y
+7 ;
+8 SET DIE="^IBE(355.31,"
SET DA=+IBDA
SET DR=".02////Dental coverage;.03////"_IBRDA
DO ^DIE
KILL DIE,DA,DR,X,Y
+9 ;
+10 SET IBX=" * "_IBNAME_IBFILE_"added"
DO MES^XPDUTL(IBX)
+11 ;
+12 ;
MH SET IBNAME="MENTAL HEALTH"
SET IBRIDER="MENTAL HEALTH COVERAGE"
+1 SET IBRDA=$ORDER(^IBE(355.6,"B",IBRIDER,0))
IF 'IBRDA
SET IBX=" - "_IBNAME_IBFILE_"Not Added, Rider Missing"
DO MES^XPDUTL(IBX)
QUIT
+2 ;
+3 IF $ORDER(^IBE(355.31,"B",IBNAME,0))
SET IBX=" - "_IBNAME_IBFILE_"already exists, no change"
DO MES^XPDUTL(IBX)
QUIT
+4 ;
+5 KILL DD,DO
SET DLAYGO=355.31
SET DIC="^IBE(355.31,"
SET DIC(0)="L"
SET X=IBNAME
DO FILE^DICN
KILL DIC
IF Y<1
KILL X,Y
QUIT
+6 SET IBDA=+Y
+7 ;
+8 SET DIE="^IBE(355.31,"
SET DA=+IBDA
SET DR=".02////Mental health coverage;.03////"_IBRDA
DO ^DIE
KILL DIE,DA,DR,X,Y
+9 ;
+10 SET IBX=" * "_IBNAME_IBFILE_"added"
DO MES^XPDUTL(IBX)
+11 ;
+12 QUIT
+13 ;
+14 ;
TOP ; inactivate Type of Plans (355.1)
+1 NEW IBNAME,IBTOPFN,IBTOPEN,IBI,IBX,DD,DO,DLAYGO,DIC,X,Y,IBDA,DIE,DA,DR
+2 DO MES^XPDUTL(" ")
+3 ;
+4 FOR IBI=1:1
SET IBNAME=$PIECE($TEXT(TOPF+IBI),";;",2)
if +IBNAME!(IBNAME="")
QUIT
Begin DoDot:1
+5 ;
+6 SET IBTOPFN=$ORDER(^IBE(355.1,"B",$EXTRACT(IBNAME,1,30),0))
+7 IF 'IBTOPFN
SET IBX=" - "_IBNAME_" Type of Plan (355.1) not defined, no change"
DO MES^XPDUTL(IBX)
QUIT
+8 ;
+9 SET IBTOPEN=$GET(^IBE(355.1,IBTOPFN,0))
+10 IF IBTOPEN=""
SET IBX=" - "_IBNAME_" Type of Plan (355.1) not found, no change"
DO MES^XPDUTL(IBX)
QUIT
+11 ;
+12 IF +$PIECE(IBTOPEN,U,4)
SET IBX=" - "_IBNAME_" Type of Plan (355.1) inactive, no change"
DO MES^XPDUTL(IBX)
QUIT
+13 ;
+14 ;
+15 SET DIE="^IBE(355.1,"
SET DA=+IBTOPFN
SET DR=".04////1"
DO ^DIE
KILL DIE,DA,DR,X,Y
+16 SET IBX=" * "_IBNAME_" Type of Plan (355.1) Inactivated"
DO MES^XPDUTL(IBX)
End DoDot:1
+17 QUIT
+18 ;
TOPF ;
+1 ;;AVIATION TRIP INSURANCE
+2 ;;BLUE CROSS/BLUE SHIELD
+3 ;;COINSURANCE
+4 ;;DUAL COVERAGE
+5 ;;HOSPITAL-MEDICAL INSURANCE
+6 ;;KEY-MAN HEALTH INSURANCE
+7 ;;MAJOR MEDICAL EXPENSE INSURANCE
+8 ;;QUALIFIED IMPAIRMENT INSURANCE
+9 ;;REGULAR MEDICAL EXPENSE INSURANCE
+10 ;;
