IBYEPT1.m

IBYEPT1 ;ALB/CPM - PATCH IB*2*40 POST INIT (CON'T) ; 22-AUG-95

 ;;Version 2.0 ; INTEGRATED BILLING ;**40**; 21-MAR-94

 ;

EN ; Entry point to queue 'Name of Insured' clean up job.

 ;

 W !!,">>> I need to queue a job to clean up the 'Name of Insured' fields in"

 W !,"    the PATIENT (#2) and BILL/CLAIMS (#399) files...",!

 ;

 ; - queue the job

 S ZTRTN="DQ^IBYEPT1",ZTIO="",ZTDESC="IB - CORRECT 'NAME OF INSURED' VALUES"

 D ^%ZTLOAD W !!,$S($D(ZTSK):"This job has been queued.  The task number is "_ZTSK_".",1:"")

 W:$D(ZTSK) !,"Please note that you will receive a mail message when this job has completed."

 K X,Y,DIRUT,DUOUT,DTOUR,DIROUT,ZTSK

 Q

 ;

 ;

 ;

DQ ; Queued entry point to start the job.

 ;

 D NOW^%DTC S IBBDT=%

 ;

 S (IBCPOL,IBCBILL)=0

 ;

 ; - fix policies in file #2

 S DFN=0 F  S DFN=$O(^DPT(DFN)) Q:'DFN  S IBCDFN=0 F  S IBCDFN=$O(^DPT(DFN,.312,IBCDFN)) Q:'IBCDFN  S IBNI=$P($G(^(IBCDFN,0)),"^",17) I IBNI?1"`"1.N D

 .S IBNAM=$$NAME(IBNI,DFN) Q:IBNAM<0

 .S $P(^DPT(DFN,.312,IBCDFN,0),"^",17)=IBNAM,IBCPOL=IBCPOL+1

 ;

 ; - fix patient's bills in file #399

 S IBIFN=0 F  S IBIFN=$O(^DGCR(399,IBIFN)) Q:'IBIFN  D

 .F IBNOD="I1","I2","I3" S IBNI=$P($G(^DGCR(399,IBIFN,IBNOD)),"^",17) I IBNI?1"`"1.N D

 ..S IBNAM=$$NAME(IBNI,+$P($G(^DGCR(399,IBIFN,0)),"^",2)) Q:IBNAM<0

 ..S $P(^DGCR(399,IBIFN,IBNOD),"^",17)=IBNAM,IBCBILL=IBCBILL+1

 ;

 D NOW^%DTC S IBEDT=%

 ;

 D MAIL

 ;

 K IBBDT,IBEDT,DFN,IBCDFN,IBNI,IBNAM,IBCPOL,IBCBILL,IBIFN,IBNOD

 Q

 ;

 ;

NAME(IBNI,DFN) ; Find the name associated with the ien for Name of Insured.

 ;  Input:  IBNI  --  Value of the Name of Insured stored in the policy

 ;           DFN  --  Pointer to the patient in file #2

 ;

 N NAME

 I $E(IBNI,2,99)=DFN S NAME=$P($G(^DPT(DFN,0)),"^") G NAMEQ

 N DIC,DFN,DGSENFLG,X S DGSENFLG=1

 S X=IBNI,DIC="^DPT(",DIC(0)="Z" D ^DIC S NAME=$S(Y<0:-1,1:$P($G(^DPT(+Y,0)),"^"))

NAMEQ Q NAME

 ;

 ;

MAIL ; Send the bulletin

 S XMSUB="Job Completion - Correct 'Name of Insured' Fields"

 S XMDUZ="INTEGRATED BILLING",XMTEXT="IBT(",XMY(DUZ)=""

 ;

 K IBT

 S IBT(1)="The job to correct the 'Name of Insured' fields in files #2 and #399"

 S IBT(2)="has completed."

 S IBT(3)=" "

 S Y=IBBDT D D^DIQ S IBT(4)="Job Start Time: "_Y

 S Y=IBEDT D D^DIQ S IBT(5)="  Job End Time: "_Y

 S IBT(6)=" "

 S IBT(7)="Number of policies corrected in file #2: "_IBCPOL

 S IBT(8)=" Number of bills corrected in file #399: "_IBCBILL

 ;

 D ^XMD

 K IBT,XMSUB,XMTEXT,XMDUZ,XMY,Y

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBYEPT1   2493     printed  Apr 23, 2025@18:50:22                                                                                                                                                                                                     Page 2

IBYEPT1   ;ALB/CPM - PATCH IB*2*40 POST INIT (CON'T) ; 22-AUG-95

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;**40**; 21-MAR-94

 +2       ;

EN        ; Entry point to queue 'Name of Insured' clean up job.

 +1       ;

 +2        WRITE !!,">>> I need to queue a job to clean up the 'Name of Insured' fields in"

 +3        WRITE !,"    the PATIENT (#2) and BILL/CLAIMS (#399) files...",!

 +4       ;

 +5       ; - queue the job

 +6        SET ZTRTN="DQ^IBYEPT1"

           SET ZTIO=""

           SET ZTDESC="IB - CORRECT 'NAME OF INSURED' VALUES"

 +7        DO ^%ZTLOAD

           WRITE !!,$SELECT($DATA(ZTSK):"This job has been queued.  The task number is "_ZTSK_".",1:"")

 +8        if $DATA(ZTSK)

               WRITE !,"Please note that you will receive a mail message when this job has completed."

 +9        KILL X,Y,DIRUT,DUOUT,DTOUR,DIROUT,ZTSK

 +10       QUIT 

 +11      ;

 +12      ;

 +13      ;

DQ        ; Queued entry point to start the job.

 +1       ;

 +2        DO NOW^%DTC

           SET IBBDT=%

 +3       ;

 +4        SET (IBCPOL,IBCBILL)=0

 +5       ;

 +6       ; - fix policies in file #2

 +7        SET DFN=0

           FOR 

               SET DFN=$ORDER(^DPT(DFN))

               if 'DFN

                   QUIT 

               SET IBCDFN=0

               FOR 

                   SET IBCDFN=$ORDER(^DPT(DFN,.312,IBCDFN))

                   if 'IBCDFN

                       QUIT 

                   SET IBNI=$PIECE($GET(^(IBCDFN,0)),"^",17)

                   IF IBNI?1"`"1.N

                       Begin DoDot:1

 +8                        SET IBNAM=$$NAME(IBNI,DFN)

                           if IBNAM<0

                               QUIT 

 +9                        SET $PIECE(^DPT(DFN,.312,IBCDFN,0),"^",17)=IBNAM

                           SET IBCPOL=IBCPOL+1

                       End DoDot:1

 +10      ;

 +11      ; - fix patient's bills in file #399

 +12       SET IBIFN=0

           FOR 

               SET IBIFN=$ORDER(^DGCR(399,IBIFN))

               if 'IBIFN

                   QUIT 

               Begin DoDot:1

 +13               FOR IBNOD="I1","I2","I3"

                       SET IBNI=$PIECE($GET(^DGCR(399,IBIFN,IBNOD)),"^",17)

                       IF IBNI?1"`"1.N

                           Begin DoDot:2

 +14                           SET IBNAM=$$NAME(IBNI,+$PIECE($GET(^DGCR(399,IBIFN,0)),"^",2))

                               if IBNAM<0

                                   QUIT 

 +15                           SET $PIECE(^DGCR(399,IBIFN,IBNOD),"^",17)=IBNAM

                               SET IBCBILL=IBCBILL+1

                           End DoDot:2

               End DoDot:1

 +16      ;

 +17       DO NOW^%DTC

           SET IBEDT=%

 +18      ;

 +19       DO MAIL

 +20      ;

 +21       KILL IBBDT,IBEDT,DFN,IBCDFN,IBNI,IBNAM,IBCPOL,IBCBILL,IBIFN,IBNOD

 +22       QUIT 

 +23      ;

 +24      ;

NAME(IBNI,DFN) ; Find the name associated with the ien for Name of Insured.

 +1       ;  Input:  IBNI  --  Value of the Name of Insured stored in the policy

 +2       ;           DFN  --  Pointer to the patient in file #2

 +3       ;

 +4        NEW NAME

 +5        IF $EXTRACT(IBNI,2,99)=DFN

               SET NAME=$PIECE($GET(^DPT(DFN,0)),"^")

               GOTO NAMEQ

 +6        NEW DIC,DFN,DGSENFLG,X

           SET DGSENFLG=1

 +7        SET X=IBNI

           SET DIC="^DPT("

           SET DIC(0)="Z"

           DO ^DIC

           SET NAME=$SELECT(Y<0:-1,1:$PIECE($GET(^DPT(+Y,0)),"^"))

NAMEQ      QUIT NAME

 +1       ;

 +2       ;

MAIL      ; Send the bulletin

 +1        SET XMSUB="Job Completion - Correct 'Name of Insured' Fields"

 +2        SET XMDUZ="INTEGRATED BILLING"

           SET XMTEXT="IBT("

           SET XMY(DUZ)=""

 +3       ;

 +4        KILL IBT

 +5        SET IBT(1)="The job to correct the 'Name of Insured' fields in files #2 and #399"

 +6        SET IBT(2)="has completed."

 +7        SET IBT(3)=" "

 +8        SET Y=IBBDT

           DO D^DIQ

           SET IBT(4)="Job Start Time: "_Y

 +9        SET Y=IBEDT

           DO D^DIQ

           SET IBT(5)="  Job End Time: "_Y

 +10       SET IBT(6)=" "

 +11       SET IBT(7)="Number of policies corrected in file #2: "_IBCPOL

 +12       SET IBT(8)=" Number of bills corrected in file #399: "_IBCBILL

 +13      ;

 +14       DO ^XMD

 +15       KILL IBT,XMSUB,XMTEXT,XMDUZ,XMY,Y

 +16       QUIT