- 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 Feb 19, 2025@00:02:08 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
