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 ---[H[J[2J[HIBYEPT1 2493 printed Nov 22, 2024@17:45:44 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
