IBYAPT1 ;ALB/CPM - PATCH IB*2*28 INSURANCE CLEAN-UP ; 30-JAN-95
;;Version 2.0 ; INTEGRATED BILLING ;**28**; 21-MAR-94
;
BKG ; Queue off a background job to clean up various insurance files.
W !!,">>> Queuing off a job to clean up various insurance files..."
W !," (You'll get a message when the job is completed)",!
S ZTRTN="FIX^IBYAPT1",ZTDTH=$H,ZTIO=""
S ZTDESC="IB - PATCH IB*2*28 POST INIT - INSURANCE CLEAN-UP"
D ^%ZTLOAD
W !?4,$S($D(ZTSK):"The job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job. Please run FIX^IBYAPT1 at any time.")
K ZTSK
Q
;
;
FIX ; Perform clean-up of Insurance Company files.
;
D NOW^%DTC S IBBDT=%
;
D PLAN ; Clean up x-refs in file #355.3
D AB ; Delete errant Annual Benefits from file #355.4
D BU ; Delete errant Benefits Used from file #355.5
D RIDER ; Delete errant Riders from file #355.7
D IR ; Repoint 'Insurance Company Contacted' for
; Insurance Reviews in file 356.2
;
D NOW^%DTC S IBEDT=%
;
D MAIL ; send out results
K IBBDT,IBEDT,IBR,IBC,IBV,IBP,IBPD,IBV1,IBCT,IBT,IBX,XMSUB,XMTEXT,XMDUZ,XMY,Y
Q
;
;
;
PLAN ; Clean up the 'AGNU' and 'AGNA' x-refs in file #355.3
F IBR="AGNA","AGNU" D
.S IBC=0 F S IBC=$O(^IBA(355.3,IBR,IBC)) Q:'IBC D
..S IBV="" F S IBV=$O(^IBA(355.3,IBR,IBC,IBV)) Q:IBV="" D
...S IBP=0 F S IBP=$O(^IBA(355.3,IBR,IBC,IBV,IBP)) Q:'IBP D
....S IBPD=$G(^IBA(355.3,IBP,0))
....S IBV1=$P(IBPD,"^",$S(IBR="AGNA":3,1:4))
....I +IBPD'=IBC!(IBV'=IBV1) S IBCT(IBR)=$G(IBCT(IBR))+1 K ^IBA(355.3,IBR,IBC,IBV,IBP)
Q
;
AB ; Delete errant Annual benefits from file #355.4
S IBC=0 F S IBC=$O(^IBA(355.4,IBC)) Q:'IBC S IBX=$G(^(IBC,0)) D
.S IBV=0 I '$P(IBX,"^",2) S IBV=1
.I 'IBV,'$D(^IBA(355.3,+$P(IBX,"^",2),0)) S IBV=1
.I IBV S DA=IBC,DIK="^IBA(355.4,",DIDEL=355.4 D ^DIK S IBCT("AB")=$G(IBCT("AB"))+1
Q
;
BU ; Delete errant Benefits Used from file #355.5
S IBC=0 F S IBC=$O(^IBA(355.5,IBC)) Q:'IBC S IBX=$G(^(IBC,0)) D
.S IBV=0 I 'IBX S IBV=1
.I 'IBV,'$D(^IBA(355.3,+IBX,0)) S IBV=1
.I 'IBV,$P($G(^DPT(+$P(IBX,"^",2),.312,+$P(IBX,"^",17),0)),"^",18)'=+IBX S IBV=1
.I IBV S DA=IBC,DIK="^IBA(355.5,",DIDEL=355.5 D ^DIK S IBCT("BU")=$G(IBCT("BU"))+1
Q
;
RIDER ; Delete errant Riders from file #355.7
S IBC=0 F S IBC=$O(^IBA(355.7,IBC)) Q:'IBC S IBX=$G(^(IBC,0)) D
.S IBV=0 I '$D(^DPT(+$P(IBX,"^",2),.312,+$P(IBX,"^",3),0)) S IBV=1
.I IBV S DA=IBC,DIK="^IBA(355.7,",DIDEL=355.7 D ^DIK S IBCT("RD")=$G(IBCT("RD"))+1
Q
;
IR ; Repoint Insurance Reviews in file #356.2
S IBC=0 F S IBC=$O(^IBT(356.2,IBC)) Q:'IBC S IBX=$G(^(IBC,0)),IBX1=$G(^(1)) D
.S IBCDFN=+$P(IBX1,"^",5),IBCDFND=$G(^DPT(+$P(IBX,"^",5),.312,IBCDFN,0))
.K IBVAL
.I IBCDFN,IBCDFND,+$P(IBX,"^",8)'=+IBCDFND S IBVAL=+IBCDFND
.I IBCDFN,'IBCDFND S IBVAL=0
.I $G(IBVAL)]"" D
..I IBVAL S DA=IBC,DR=".08////"_+IBCDFND,DIE="^IBT(356.2," D ^DIE K DIE,DA,DR
..I 'IBVAL S $P(^IBT(356.2,IBC,1),"^",5)=""
..S IBCT("IR")=$G(IBCT("IR"))+1
K IBX1,IBCDFN,IBCDFND,IBVAL
Q
;
MAIL ; Send results out.
S XMSUB="Patch IB*2*28 Insurance Clean-up Completion"
S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="IBT(",XMY(DUZ)=""
;
K IBT
S IBT(1)="The Insurance Files clean-up job has completed."
S IBT(2)=" "
S Y=IBBDT D D^DIQ S IBT(3)="Job Start Time: "_Y
S Y=IBEDT D D^DIQ S IBT(4)=" Job End Time: "_Y
S IBT(5)=" "
S IBT(6)=" Number of AGNA cross references in file #355.3 deleted: "_+$G(IBCT("AGNA"))
S IBT(7)=" Number of AGNU cross references in file #355.3 deleted: "_+$G(IBCT("AGNU"))
S IBT(8)="Number of errant Annual Benefits in file #355.4 deleted: "_+$G(IBCT("AB"))
S IBT(9)=" Number of errant Benefits Used in file #355.5 deleted: "_+$G(IBCT("BU"))
S IBT(10)="Number of errant Personal Riders in file #355.7 deleted: "_+$G(IBCT("RD"))
S IBT(11)=" Number of Insurance Reviews in file #356.2 repointed: "_+$G(IBCT("IR"))
;
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBYAPT1 3971 printed Nov 22, 2024@17:45:39 Page 2
IBYAPT1 ;ALB/CPM - PATCH IB*2*28 INSURANCE CLEAN-UP ; 30-JAN-95
+1 ;;Version 2.0 ; INTEGRATED BILLING ;**28**; 21-MAR-94
+2 ;
BKG ; Queue off a background job to clean up various insurance files.
+1 WRITE !!,">>> Queuing off a job to clean up various insurance files..."
+2 WRITE !," (You'll get a message when the job is completed)",!
+3 SET ZTRTN="FIX^IBYAPT1"
SET ZTDTH=$HOROLOG
SET ZTIO=""
+4 SET ZTDESC="IB - PATCH IB*2*28 POST INIT - INSURANCE CLEAN-UP"
+5 DO ^%ZTLOAD
+6 WRITE !?4,$SELECT($DATA(ZTSK):"The job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job. Please run FIX^IBYAPT1 at any time.")
+7 KILL ZTSK
+8 QUIT
+9 ;
+10 ;
FIX ; Perform clean-up of Insurance Company files.
+1 ;
+2 DO NOW^%DTC
SET IBBDT=%
+3 ;
+4 ; Clean up x-refs in file #355.3
DO PLAN
+5 ; Delete errant Annual Benefits from file #355.4
DO AB
+6 ; Delete errant Benefits Used from file #355.5
DO BU
+7 ; Delete errant Riders from file #355.7
DO RIDER
+8 ; Repoint 'Insurance Company Contacted' for
DO IR
+9 ; Insurance Reviews in file 356.2
+10 ;
+11 DO NOW^%DTC
SET IBEDT=%
+12 ;
+13 ; send out results
DO MAIL
+14 KILL IBBDT,IBEDT,IBR,IBC,IBV,IBP,IBPD,IBV1,IBCT,IBT,IBX,XMSUB,XMTEXT,XMDUZ,XMY,Y
+15 QUIT
+16 ;
+17 ;
+18 ;
PLAN ; Clean up the 'AGNU' and 'AGNA' x-refs in file #355.3
+1 FOR IBR="AGNA","AGNU"
Begin DoDot:1
+2 SET IBC=0
FOR
SET IBC=$ORDER(^IBA(355.3,IBR,IBC))
if 'IBC
QUIT
Begin DoDot:2
+3 SET IBV=""
FOR
SET IBV=$ORDER(^IBA(355.3,IBR,IBC,IBV))
if IBV=""
QUIT
Begin DoDot:3
+4 SET IBP=0
FOR
SET IBP=$ORDER(^IBA(355.3,IBR,IBC,IBV,IBP))
if 'IBP
QUIT
Begin DoDot:4
+5 SET IBPD=$GET(^IBA(355.3,IBP,0))
+6 SET IBV1=$PIECE(IBPD,"^",$SELECT(IBR="AGNA":3,1:4))
+7 IF +IBPD'=IBC!(IBV'=IBV1)
SET IBCT(IBR)=$GET(IBCT(IBR))+1
KILL ^IBA(355.3,IBR,IBC,IBV,IBP)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
AB ; Delete errant Annual benefits from file #355.4
+1 SET IBC=0
FOR
SET IBC=$ORDER(^IBA(355.4,IBC))
if 'IBC
QUIT
SET IBX=$GET(^(IBC,0))
Begin DoDot:1
+2 SET IBV=0
IF '$PIECE(IBX,"^",2)
SET IBV=1
+3 IF 'IBV
IF '$DATA(^IBA(355.3,+$PIECE(IBX,"^",2),0))
SET IBV=1
+4 IF IBV
SET DA=IBC
SET DIK="^IBA(355.4,"
SET DIDEL=355.4
DO ^DIK
SET IBCT("AB")=$GET(IBCT("AB"))+1
End DoDot:1
+5 QUIT
+6 ;
BU ; Delete errant Benefits Used from file #355.5
+1 SET IBC=0
FOR
SET IBC=$ORDER(^IBA(355.5,IBC))
if 'IBC
QUIT
SET IBX=$GET(^(IBC,0))
Begin DoDot:1
+2 SET IBV=0
IF 'IBX
SET IBV=1
+3 IF 'IBV
IF '$DATA(^IBA(355.3,+IBX,0))
SET IBV=1
+4 IF 'IBV
IF $PIECE($GET(^DPT(+$PIECE(IBX,"^",2),.312,+$PIECE(IBX,"^",17),0)),"^",18)'=+IBX
SET IBV=1
+5 IF IBV
SET DA=IBC
SET DIK="^IBA(355.5,"
SET DIDEL=355.5
DO ^DIK
SET IBCT("BU")=$GET(IBCT("BU"))+1
End DoDot:1
+6 QUIT
+7 ;
RIDER ; Delete errant Riders from file #355.7
+1 SET IBC=0
FOR
SET IBC=$ORDER(^IBA(355.7,IBC))
if 'IBC
QUIT
SET IBX=$GET(^(IBC,0))
Begin DoDot:1
+2 SET IBV=0
IF '$DATA(^DPT(+$PIECE(IBX,"^",2),.312,+$PIECE(IBX,"^",3),0))
SET IBV=1
+3 IF IBV
SET DA=IBC
SET DIK="^IBA(355.7,"
SET DIDEL=355.7
DO ^DIK
SET IBCT("RD")=$GET(IBCT("RD"))+1
End DoDot:1
+4 QUIT
+5 ;
IR ; Repoint Insurance Reviews in file #356.2
+1 SET IBC=0
FOR
SET IBC=$ORDER(^IBT(356.2,IBC))
if 'IBC
QUIT
SET IBX=$GET(^(IBC,0))
SET IBX1=$GET(^(1))
Begin DoDot:1
+2 SET IBCDFN=+$PIECE(IBX1,"^",5)
SET IBCDFND=$GET(^DPT(+$PIECE(IBX,"^",5),.312,IBCDFN,0))
+3 KILL IBVAL
+4 IF IBCDFN
IF IBCDFND
IF +$PIECE(IBX,"^",8)'=+IBCDFND
SET IBVAL=+IBCDFND
+5 IF IBCDFN
IF 'IBCDFND
SET IBVAL=0
+6 IF $GET(IBVAL)]""
Begin DoDot:2
+7 IF IBVAL
SET DA=IBC
SET DR=".08////"_+IBCDFND
SET DIE="^IBT(356.2,"
DO ^DIE
KILL DIE,DA,DR
+8 IF 'IBVAL
SET $PIECE(^IBT(356.2,IBC,1),"^",5)=""
+9 SET IBCT("IR")=$GET(IBCT("IR"))+1
End DoDot:2
End DoDot:1
+10 KILL IBX1,IBCDFN,IBCDFND,IBVAL
+11 QUIT
+12 ;
MAIL ; Send results out.
+1 SET XMSUB="Patch IB*2*28 Insurance Clean-up Completion"
+2 SET XMDUZ="INTEGRATED BILLING PACKAGE"
SET XMTEXT="IBT("
SET XMY(DUZ)=""
+3 ;
+4 KILL IBT
+5 SET IBT(1)="The Insurance Files clean-up job has completed."
+6 SET IBT(2)=" "
+7 SET Y=IBBDT
DO D^DIQ
SET IBT(3)="Job Start Time: "_Y
+8 SET Y=IBEDT
DO D^DIQ
SET IBT(4)=" Job End Time: "_Y
+9 SET IBT(5)=" "
+10 SET IBT(6)=" Number of AGNA cross references in file #355.3 deleted: "_+$GET(IBCT("AGNA"))
+11 SET IBT(7)=" Number of AGNU cross references in file #355.3 deleted: "_+$GET(IBCT("AGNU"))
+12 SET IBT(8)="Number of errant Annual Benefits in file #355.4 deleted: "_+$GET(IBCT("AB"))
+13 SET IBT(9)=" Number of errant Benefits Used in file #355.5 deleted: "_+$GET(IBCT("BU"))
+14 SET IBT(10)="Number of errant Personal Riders in file #355.7 deleted: "_+$GET(IBCT("RD"))
+15 SET IBT(11)=" Number of Insurance Reviews in file #356.2 repointed: "_+$GET(IBCT("IR"))
+16 ;
+17 DO ^XMD
+18 QUIT
