IBJDE1 ;ALB/RB - DM DATA EXTRACTION (MENU OPTIONS/TRANSMIT E-MAIL) ;15-APR-99
;;2.0;INTEGRATED BILLING;**100,118,123,159,254,244**;21-MAR-94
;
VPE ; - View/print entries in IB DM EXTRACT DATA file (#351.71).
I '$O(^IBE(351.71,0)) W !!,"There are no entries available.",*7 G ENQ
;
S DIC="^IBE(351.71,",DIC(0)="AEMQZ",DIC("A")="Enter MONTH/YEAR: "
D ^DIC K DIC G:Y'>0 ENQ S IB0=+Y,IBS=$P(Y(0),U,2),IBDT=Y(0,0)
;
S DIC="^IBE(351.71,",BY=.01,(FR,TO)=IB0,DHD="W ?0 D VPH^IBJDE1"
S FLDS="[IBJD DM V/P EXTRACTS]",L=0 D EN1^DIP W ! G VPE
;
VPH ; - Heading for View/Print option.
W "DIAGNOSTIC MEASURES SUMMARY EXTRACTIONS-",IBDT
W " (Status: ",$S(IBS=3:"COMPLETED",IBS=2:"STARTED",1:"ON STANDBY"),")"
W !!,"Summary Line Item",?58,"Total",! F X=1:1:80 W "-"
Q
;
DER ; - Disable/enable report(s) or extraction process.
W ! S DIR(0)="Y",DIR("B")="NO"
I $D(^IBE(351.7,"DISABLE")) D
.S DIR("A",1)="The DM extract background job has been disabled."
.S DIR("A")=" Do you want to re-enable it"
E S DIR("A")="Do you want to disable the DM extract background job"
D ^DIR K DIR G:Y["^" ENQ I 'Y G DE1
I $D(^IBE(351.7,"DISABLE")) K ^("DISABLE")
E S ^IBE(351.7,"DISABLE")=""
W " ...Done",*7
;
DE1 ; - List disabled reports, if any.
I $D(^IBE(351.7,"DISABLE")) G ENQ ; DM extract background job disabled.
;
I $D(^IBE(351.7,"AC",1)) D
.W !!,"These DM reports have been disabled:",!! S X=0
.F S X=$O(^IBE(351.7,"AC",1,X)) Q:'X W ?3,$P($G(^IBE(351.7,X,0)),U),!
E W !!,"There are no disabled DM reports.",!
;
DE2 S DIR(0)="PO^351.7:AEMQZ",DIR("A")="Enter REPORT NAME"
S DIR("?")="^D DEH^IBJDE1" D ^DIR K DIR I Y'>0 G ENQ
S IB0=+Y,IBFL=$P(Y(0),U,2) W !!,Y(0,0),!
;
S DIR("A")="Do you want to "_$S(IBFL:"re-en",1:"dis")_"able this report"
S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR I Y["^"!('Y) W ! G DE2
S DIE="^IBE(351.7,",DR=".02///"_$S('IBFL&(Y):1,1:"@"),DA=IB0
D ^DIE K DA,DIE,DR W " ...Done",*7 G DE1
;
DEH ; - Help message for disable/enable option.
W !,"Enter the name of the report you want disabled or re-enabled."
W !,"If the report you enter is disabled, the monthly DM extraction"
W !,"process will not collect summary data from the report until you"
W !,"re-enable it again."
Q
;
RTN ; - Help message for the field ROUTINE (entry point for the reprot)
W !?9,"Enter the entry point for this report. You may enter a program"
W !?9,"name (^ROUTINE), or a specific label of a program (TAG^ROUTINE)"
W !?9,"or you may also leave it blank.",!
W !?9,"Obs: If this field is left blank, it means that the code respon-"
W !?9," sible for extracting the data will be invoked by another"
W !?9," report.",!
Q
;
MAN1 ; - Manually start DM extraction process.
I $D(^IBE(351.7,"DISABLE")) D G ENQ
.W !!,"The DM extract process has been disabled.",!,*7
S (IBX,X)=0
F S X=$O(^IBE(351.71,X)) Q:'X I $P(^(X,0),U,2)'=3 S IBX=IBX+1
I 'IBX W !,"All DM extracts on file have been transmitted.",!,*7 G ENQ
;
M1A S DIC="^IBE(351.71,",DIC(0)="AEMQZ",DIC("A")="Enter DM extract date: "
S DIC("S")="I $P(^(0),U,2)'=3" W ! D ^DIC K DIC I Y'>0 G ENQ
S IBDT=+Y,IBN=Y(0),IBDT1=$$M1^IBJDE(IBDT,3),IBST=$P(IBN,U,2)
S DIR("A")="Do you want to start the DM extract process for "_IBDT1
S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR I 'Y G ENQ
I IBST=2 D G:'Y ENQ
.S DIR(0)="Y",DIR("B")="NO",IBS=$$M1^IBJDE($P(IBN,U,3),3)
.S DIR("A",1)="The extract process for "_IBDT1_" began on "_IBS_"."
.S DIR("A")="Do you want to restart it" W ! D ^DIR K DIR
;
D BJ^IBJDE ; Start DM extraction background job.
S IBS=$$M1^IBJDE($P($G(^IBE(351.71,IBDT,0)),U,3),3)
W !!,"Extract process started on ",IBS,".",*7 S IBX=IBX-1
I IBX D G:Y M1A
.S DIR("A")="Do you want to start the process for another date"
.S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR
;
G ENQ
;
MAN2 ; - Manually transmit DM extract file.
I $D(^IBE(351.7,"DISABLE")) D G ENQ
.W !!,"The DM extract process has been disabled.",!,*7
S (IBX,X)=0
F S X=$O(^IBE(351.71,X)) Q:'X I $P(^(X,0),U,2)=3 S IBX=IBX+1
I 'IBX D G ENQ
.W !,"All DM extracts on file have NOT been completed.",!,*7
;
M2A S DIC="^IBE(351.71,",DIC(0)="AEMQZ",DIC("A")="Enter DM extract date: "
S DIC("S")="I $P(^(0),U,2)=3" W ! D ^DIC K DIC I Y'>0 G ENQ
S IBDT=+Y,IBN=Y(0),DIR(0)="Y",DIR("B")="NO"
S DIR("A")="Are you sure you want to transmit for "_$$M1^IBJDE(IBDT,3)
D ^DIR K DIR I 'Y G M2A
M2B S $P(^IBE(351.71,IBDT,0),U,5)="" D XM(IBDT)
I $G(XMZ) W " Done."
E D G:Y M2B
.S DIR(0)="Y",DIR("B")="NO"
.S DIR("A")="The DM extract message failed to transmit...try again"
.W !,*7 D ^DIR K DIR
;
I IBX D G:Y M2A
.S DIR("A")="Do you want to start the process for another date"
.S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR I Y S IBX=IBX-1
;
G ENQ
;
MSG ; - DM extract reports message (shown when DM Menu is called up).
S IBDT=$$M1^IBJDE(DT,1),IBDT1=$$M1^IBJDE(IBDT,3)
I '$D(^IBE(351.71,IBDT,0)) G ENQ ; No extract data for this month yet.
;
W @IOF S IBN=$G(^IBE(351.71,IBDT,0)),IBST=$P(IBN,U,2) I 'IBST G ENQ
I IBST=1 D G MSQ
.W !,"The DM extract process for ",IBDT1," was initiated on "
.W $$M1^IBJDE($P(IBN,U,3),3),!,"but it hasn't run yet.",!
;
I IBST=3 D G ENQ
.W !,"The DM report data for ",IBDT1," has been successfully"
.W !,"extracted on ",$$M1^IBJDE($P(IBN,U,4),3),". This data has been"
.W !,"sent to the Central Collections mail group in FORUM.",*7
;
S DIC="^IBE(351.71,",BY="[IBJD DM REPT SORT]",FR=IBDT_",1",TO=IBDT_",2"
S DIOEND="I $Y'<(IOSL-14) R X:DTIME",(IOP,L)=0
S DHD="W ?0 D MSH^IBJDE1",FLDS="[IBJD DM REPT PRINT]" D EN1^DIP
;
MSQ W !,"If you want, you can restart the DM extract process"
W !,"by using the ""Manually Start DM Extraction"" option in"
W !,"the Diagnostic Measures Extract Menu."
G ENQ
;
MSH ; - DM extract reports message header.
W !,"Data for the following DM reports have not been extracted"
W !," for ",IBDT1,":",!!,*7
Q
;
CHK ; - Check file #351.71 for completed and/or transmitted DM extracts
; (shown when DM Extract Menu is called up).
W @IOF,!,"Checking for completed and/or transmitted DM extracts"
K IBX,IBX1 S (IBX,IBX1,IB0)=0
S DT=$$DT^XLFDT
F S IB0=$O(^IBE(351.71,IB0)) Q:'IB0 S IBN=$G(^(IB0,0)) D
.; - Do not process for invalid (day not equal 00 or future) dates
.; and remove data.
.I (+$E(IB0,6,7)>0)!(IB0>DT) D Q
..W !,"** Invalid date entry found. Entry ("_IB0_") deleted.**",!
..S DIK="^IBE(351.71,",DA=IB0
..D ^DIK
.; - Check for missing zero node.
.I IBN="" W !,"Zero node data missing for "_IB0_" entry. Data corruption possible.",! Q
.; - Check for past months missing from file, if any.
.I $O(^IBE(351.71,IB0)) D
..S IB1=$P(^IBE(351.71,0),U,4),IB2=IB0+$S($E(IB0,4,5)=12:8900,1:100)
..I $D(^IBE(351.71,"B",IB2,IB2))!(IB2>DT) Q
..S DIC="^IBE(351.71,",DIC(0)="L",DIC("DR")=".02///1",(DINUM,X)=IB2
..K DD,DO D FILE^DICN S $P(^IBE(351.71,0),U,4)=IB1+1 K DIC,DINUM,DD,DO
.;
.I $P(IBN,U,2)'=3 S IBX(IB0)="" S:'IBX IBX=1 Q
.E I '$P(IBN,U,5) S IBX1(IB0)="" S:'IBX1 IBX1=1 Q
.W "."
;
I 'IBX,'IBX1 W "Done" G ENQ
I IBX D
.W !!,"DM data has NOT been fully extracted for these months:",!,*7
.S IB0=0 F S IB0=$O(IBX(IB0)) Q:'IB0 W " ",$$M1^IBJDE(IB0,3)
.W !,"If you want, you can start the DM extract process for these"
.W !,"months by using the ""Manually Start DM Extraction"" option."
;
I IBX1 D
.W !!,"DM data has NOT been transmitted for these months:",!,*7
.S IB0=0 F S IB0=$O(IBX1(IB0)) Q:'IB0 W " ",$$M1^IBJDE(IB0,3)
.W !,"If you want, you can transmit the DM extract data for these"
.W !,"months by using the ""Manually Transmit DM Extract"" option."
;
G ENQ
;
XM(IBDT) ; - Create/transmit DM extract file message.
;
N DA,DIE,DR,IB0,IB1,IBC,IBDT1,IBMG,IBSTE,X,XMDUZ,XMSUB,XMTEXT
;
K ^TMP("DME",$J) S IBSTE=$$SITE^VASITE,X=$E(DT,4,7)_(1700+$E(DT,1,3))
S ^TMP("DME",$J,1)="HDR^"_$P(IBSTE,U,3)_U_$P(IBSTE,U,2)_U_X
S IBC=1,IB0=0
F S IB0=$O(^IBE(351.71,IBDT,1,IB0)) Q:'IB0 D
.Q:IB0=37 ; No unbilled report needed
.S X=$S(IB0=8:$$M2^IBJDE(IBDT,5,3,1),1:$$M1^IBJDE(IBDT,2))
.S IBC=IBC+1,^TMP("DME",$J,IBC)="DAT~"_IB0_"~"_$P(X,U)_"~"_$P(X,U,2)
.S IB1=0 F S IB1=$O(^IBE(351.71,IBDT,1,IB0,1,IB1)) Q:'IB1 D
..S X=$P($G(^IBE(351.71,IBDT,1,IB0,1,IB1,0)),U,2)
..S ^TMP("DME",$J,IBC)=^TMP("DME",$J,IBC)_U_X
;
S ^TMP("DME",$J,IBC+1)="END^"_$P(IBSTE,U,3),IBDT1=$$M1^IBJDE(IBDT,3)
S XMSUB="DIAG. MEASURES EXTRACT FILE-"_IBDT1_" ("_$P(IBSTE,U,2)_")"
;
S IBMG=$P($G(^IBE(350.9,1,4)),U,5) I IBMG="" G ENQ:'$G(IBX),ENQ1
;
S XMDUZ="INTEGRATED BILLING PACKAGE"
S XMTEXT="^TMP(""DME"",$J,",XMY(IBMG)=""
D SEND
I $G(XMZ) S DIE="^IBE(351.71,",DA=IBDT,DR=".05///1;.06///"_XMZ D ^DIE
;
I $G(IBX) G ENQ1 ; Return to DME manual transmit option.
;
ENQ K IB2,IBDT2,IBD1,IBD2,IBDT,IBFL,IBFR,IBN,IBS,IBST,IBST1,IBX,IBX1,BY,DHD
K DIC,DIOEND,FLDS,FR,IOP,L,TO,X,XMZ,Y,%
ENQ1 K IB0,IB1,IBC,IBDT1,IBMG,IBSTE,XMSUB,XMTEXT,XMY,^TMP("DME",$J)
Q
;
SEND ; Calls ^XMD to send the mail message with the data extracted
; Obs: By NEWing DUZ, ^XMD will assume DUZ=.5 (Sender=POSTMASTER)
;
N DUZ D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJDE1 9217 printed Oct 16, 2024@18:23:20 Page 2
IBJDE1 ;ALB/RB - DM DATA EXTRACTION (MENU OPTIONS/TRANSMIT E-MAIL) ;15-APR-99
+1 ;;2.0;INTEGRATED BILLING;**100,118,123,159,254,244**;21-MAR-94
+2 ;
VPE ; - View/print entries in IB DM EXTRACT DATA file (#351.71).
+1 IF '$ORDER(^IBE(351.71,0))
WRITE !!,"There are no entries available.",*7
GOTO ENQ
+2 ;
+3 SET DIC="^IBE(351.71,"
SET DIC(0)="AEMQZ"
SET DIC("A")="Enter MONTH/YEAR: "
+4 DO ^DIC
KILL DIC
if Y'>0
GOTO ENQ
SET IB0=+Y
SET IBS=$PIECE(Y(0),U,2)
SET IBDT=Y(0,0)
+5 ;
+6 SET DIC="^IBE(351.71,"
SET BY=.01
SET (FR,TO)=IB0
SET DHD="W ?0 D VPH^IBJDE1"
+7 SET FLDS="[IBJD DM V/P EXTRACTS]"
SET L=0
DO EN1^DIP
WRITE !
GOTO VPE
+8 ;
VPH ; - Heading for View/Print option.
+1 WRITE "DIAGNOSTIC MEASURES SUMMARY EXTRACTIONS-",IBDT
+2 WRITE " (Status: ",$SELECT(IBS=3:"COMPLETED",IBS=2:"STARTED",1:"ON STANDBY"),")"
+3 WRITE !!,"Summary Line Item",?58,"Total",!
FOR X=1:1:80
WRITE "-"
+4 QUIT
+5 ;
DER ; - Disable/enable report(s) or extraction process.
+1 WRITE !
SET DIR(0)="Y"
SET DIR("B")="NO"
+2 IF $DATA(^IBE(351.7,"DISABLE"))
Begin DoDot:1
+3 SET DIR("A",1)="The DM extract background job has been disabled."
+4 SET DIR("A")=" Do you want to re-enable it"
End DoDot:1
+5 IF '$TEST
SET DIR("A")="Do you want to disable the DM extract background job"
+6 DO ^DIR
KILL DIR
if Y["^"
GOTO ENQ
IF 'Y
GOTO DE1
+7 IF $DATA(^IBE(351.7,"DISABLE"))
KILL ^("DISABLE")
+8 IF '$TEST
SET ^IBE(351.7,"DISABLE")=""
+9 WRITE " ...Done",*7
+10 ;
DE1 ; - List disabled reports, if any.
+1 ; DM extract background job disabled.
IF $DATA(^IBE(351.7,"DISABLE"))
GOTO ENQ
+2 ;
+3 IF $DATA(^IBE(351.7,"AC",1))
Begin DoDot:1
+4 WRITE !!,"These DM reports have been disabled:",!!
SET X=0
+5 FOR
SET X=$ORDER(^IBE(351.7,"AC",1,X))
if 'X
QUIT
WRITE ?3,$PIECE($GET(^IBE(351.7,X,0)),U),!
End DoDot:1
+6 IF '$TEST
WRITE !!,"There are no disabled DM reports.",!
+7 ;
DE2 SET DIR(0)="PO^351.7:AEMQZ"
SET DIR("A")="Enter REPORT NAME"
+1 SET DIR("?")="^D DEH^IBJDE1"
DO ^DIR
KILL DIR
IF Y'>0
GOTO ENQ
+2 SET IB0=+Y
SET IBFL=$PIECE(Y(0),U,2)
WRITE !!,Y(0,0),!
+3 ;
+4 SET DIR("A")="Do you want to "_$SELECT(IBFL:"re-en",1:"dis")_"able this report"
+5 SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
IF Y["^"!('Y)
WRITE !
GOTO DE2
+6 SET DIE="^IBE(351.7,"
SET DR=".02///"_$SELECT('IBFL&(Y):1,1:"@")
SET DA=IB0
+7 DO ^DIE
KILL DA,DIE,DR
WRITE " ...Done",*7
GOTO DE1
+8 ;
DEH ; - Help message for disable/enable option.
+1 WRITE !,"Enter the name of the report you want disabled or re-enabled."
+2 WRITE !,"If the report you enter is disabled, the monthly DM extraction"
+3 WRITE !,"process will not collect summary data from the report until you"
+4 WRITE !,"re-enable it again."
+5 QUIT
+6 ;
RTN ; - Help message for the field ROUTINE (entry point for the reprot)
+1 WRITE !?9,"Enter the entry point for this report. You may enter a program"
+2 WRITE !?9,"name (^ROUTINE), or a specific label of a program (TAG^ROUTINE)"
+3 WRITE !?9,"or you may also leave it blank.",!
+4 WRITE !?9,"Obs: If this field is left blank, it means that the code respon-"
+5 WRITE !?9," sible for extracting the data will be invoked by another"
+6 WRITE !?9," report.",!
+7 QUIT
+8 ;
MAN1 ; - Manually start DM extraction process.
+1 IF $DATA(^IBE(351.7,"DISABLE"))
Begin DoDot:1
+2 WRITE !!,"The DM extract process has been disabled.",!,*7
End DoDot:1
GOTO ENQ
+3 SET (IBX,X)=0
+4 FOR
SET X=$ORDER(^IBE(351.71,X))
if 'X
QUIT
IF $PIECE(^(X,0),U,2)'=3
SET IBX=IBX+1
+5 IF 'IBX
WRITE !,"All DM extracts on file have been transmitted.",!,*7
GOTO ENQ
+6 ;
M1A SET DIC="^IBE(351.71,"
SET DIC(0)="AEMQZ"
SET DIC("A")="Enter DM extract date: "
+1 SET DIC("S")="I $P(^(0),U,2)'=3"
WRITE !
DO ^DIC
KILL DIC
IF Y'>0
GOTO ENQ
+2 SET IBDT=+Y
SET IBN=Y(0)
SET IBDT1=$$M1^IBJDE(IBDT,3)
SET IBST=$PIECE(IBN,U,2)
+3 SET DIR("A")="Do you want to start the DM extract process for "_IBDT1
+4 SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
IF 'Y
GOTO ENQ
+5 IF IBST=2
Begin DoDot:1
+6 SET DIR(0)="Y"
SET DIR("B")="NO"
SET IBS=$$M1^IBJDE($PIECE(IBN,U,3),3)
+7 SET DIR("A",1)="The extract process for "_IBDT1_" began on "_IBS_"."
+8 SET DIR("A")="Do you want to restart it"
WRITE !
DO ^DIR
KILL DIR
End DoDot:1
if 'Y
GOTO ENQ
+9 ;
+10 ; Start DM extraction background job.
DO BJ^IBJDE
+11 SET IBS=$$M1^IBJDE($PIECE($GET(^IBE(351.71,IBDT,0)),U,3),3)
+12 WRITE !!,"Extract process started on ",IBS,".",*7
SET IBX=IBX-1
+13 IF IBX
Begin DoDot:1
+14 SET DIR("A")="Do you want to start the process for another date"
+15 SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
End DoDot:1
if Y
GOTO M1A
+16 ;
+17 GOTO ENQ
+18 ;
MAN2 ; - Manually transmit DM extract file.
+1 IF $DATA(^IBE(351.7,"DISABLE"))
Begin DoDot:1
+2 WRITE !!,"The DM extract process has been disabled.",!,*7
End DoDot:1
GOTO ENQ
+3 SET (IBX,X)=0
+4 FOR
SET X=$ORDER(^IBE(351.71,X))
if 'X
QUIT
IF $PIECE(^(X,0),U,2)=3
SET IBX=IBX+1
+5 IF 'IBX
Begin DoDot:1
+6 WRITE !,"All DM extracts on file have NOT been completed.",!,*7
End DoDot:1
GOTO ENQ
+7 ;
M2A SET DIC="^IBE(351.71,"
SET DIC(0)="AEMQZ"
SET DIC("A")="Enter DM extract date: "
+1 SET DIC("S")="I $P(^(0),U,2)=3"
WRITE !
DO ^DIC
KILL DIC
IF Y'>0
GOTO ENQ
+2 SET IBDT=+Y
SET IBN=Y(0)
SET DIR(0)="Y"
SET DIR("B")="NO"
+3 SET DIR("A")="Are you sure you want to transmit for "_$$M1^IBJDE(IBDT,3)
+4 DO ^DIR
KILL DIR
IF 'Y
GOTO M2A
M2B SET $PIECE(^IBE(351.71,IBDT,0),U,5)=""
DO XM(IBDT)
+1 IF $GET(XMZ)
WRITE " Done."
+2 IF '$TEST
Begin DoDot:1
+3 SET DIR(0)="Y"
SET DIR("B")="NO"
+4 SET DIR("A")="The DM extract message failed to transmit...try again"
+5 WRITE !,*7
DO ^DIR
KILL DIR
End DoDot:1
if Y
GOTO M2B
+6 ;
+7 IF IBX
Begin DoDot:1
+8 SET DIR("A")="Do you want to start the process for another date"
+9 SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
IF Y
SET IBX=IBX-1
End DoDot:1
if Y
GOTO M2A
+10 ;
+11 GOTO ENQ
+12 ;
MSG ; - DM extract reports message (shown when DM Menu is called up).
+1 SET IBDT=$$M1^IBJDE(DT,1)
SET IBDT1=$$M1^IBJDE(IBDT,3)
+2 ; No extract data for this month yet.
IF '$DATA(^IBE(351.71,IBDT,0))
GOTO ENQ
+3 ;
+4 WRITE @IOF
SET IBN=$GET(^IBE(351.71,IBDT,0))
SET IBST=$PIECE(IBN,U,2)
IF 'IBST
GOTO ENQ
+5 IF IBST=1
Begin DoDot:1
+6 WRITE !,"The DM extract process for ",IBDT1," was initiated on "
+7 WRITE $$M1^IBJDE($PIECE(IBN,U,3),3),!,"but it hasn't run yet.",!
End DoDot:1
GOTO MSQ
+8 ;
+9 IF IBST=3
Begin DoDot:1
+10 WRITE !,"The DM report data for ",IBDT1," has been successfully"
+11 WRITE !,"extracted on ",$$M1^IBJDE($PIECE(IBN,U,4),3),". This data has been"
+12 WRITE !,"sent to the Central Collections mail group in FORUM.",*7
End DoDot:1
GOTO ENQ
+13 ;
+14 SET DIC="^IBE(351.71,"
SET BY="[IBJD DM REPT SORT]"
SET FR=IBDT_",1"
SET TO=IBDT_",2"
+15 SET DIOEND="I $Y'<(IOSL-14) R X:DTIME"
SET (IOP,L)=0
+16 SET DHD="W ?0 D MSH^IBJDE1"
SET FLDS="[IBJD DM REPT PRINT]"
DO EN1^DIP
+17 ;
MSQ WRITE !,"If you want, you can restart the DM extract process"
+1 WRITE !,"by using the ""Manually Start DM Extraction"" option in"
+2 WRITE !,"the Diagnostic Measures Extract Menu."
+3 GOTO ENQ
+4 ;
MSH ; - DM extract reports message header.
+1 WRITE !,"Data for the following DM reports have not been extracted"
+2 WRITE !," for ",IBDT1,":",!!,*7
+3 QUIT
+4 ;
CHK ; - Check file #351.71 for completed and/or transmitted DM extracts
+1 ; (shown when DM Extract Menu is called up).
+2 WRITE @IOF,!,"Checking for completed and/or transmitted DM extracts"
+3 KILL IBX,IBX1
SET (IBX,IBX1,IB0)=0
+4 SET DT=$$DT^XLFDT
+5 FOR
SET IB0=$ORDER(^IBE(351.71,IB0))
if 'IB0
QUIT
SET IBN=$GET(^(IB0,0))
Begin DoDot:1
+6 ; - Do not process for invalid (day not equal 00 or future) dates
+7 ; and remove data.
+8 IF (+$EXTRACT(IB0,6,7)>0)!(IB0>DT)
Begin DoDot:2
+9 WRITE !,"** Invalid date entry found. Entry ("_IB0_") deleted.**",!
+10 SET DIK="^IBE(351.71,"
SET DA=IB0
+11 DO ^DIK
End DoDot:2
QUIT
+12 ; - Check for missing zero node.
+13 IF IBN=""
WRITE !,"Zero node data missing for "_IB0_" entry. Data corruption possible.",!
QUIT
+14 ; - Check for past months missing from file, if any.
+15 IF $ORDER(^IBE(351.71,IB0))
Begin DoDot:2
+16 SET IB1=$PIECE(^IBE(351.71,0),U,4)
SET IB2=IB0+$SELECT($EXTRACT(IB0,4,5)=12:8900,1:100)
+17 IF $DATA(^IBE(351.71,"B",IB2,IB2))!(IB2>DT)
QUIT
+18 SET DIC="^IBE(351.71,"
SET DIC(0)="L"
SET DIC("DR")=".02///1"
SET (DINUM,X)=IB2
+19 KILL DD,DO
DO FILE^DICN
SET $PIECE(^IBE(351.71,0),U,4)=IB1+1
KILL DIC,DINUM,DD,DO
End DoDot:2
+20 ;
+21 IF $PIECE(IBN,U,2)'=3
SET IBX(IB0)=""
if 'IBX
SET IBX=1
QUIT
+22 IF '$TEST
IF '$PIECE(IBN,U,5)
SET IBX1(IB0)=""
if 'IBX1
SET IBX1=1
QUIT
+23 WRITE "."
End DoDot:1
+24 ;
+25 IF 'IBX
IF 'IBX1
WRITE "Done"
GOTO ENQ
+26 IF IBX
Begin DoDot:1
+27 WRITE !!,"DM data has NOT been fully extracted for these months:",!,*7
+28 SET IB0=0
FOR
SET IB0=$ORDER(IBX(IB0))
if 'IB0
QUIT
WRITE " ",$$M1^IBJDE(IB0,3)
+29 WRITE !,"If you want, you can start the DM extract process for these"
+30 WRITE !,"months by using the ""Manually Start DM Extraction"" option."
End DoDot:1
+31 ;
+32 IF IBX1
Begin DoDot:1
+33 WRITE !!,"DM data has NOT been transmitted for these months:",!,*7
+34 SET IB0=0
FOR
SET IB0=$ORDER(IBX1(IB0))
if 'IB0
QUIT
WRITE " ",$$M1^IBJDE(IB0,3)
+35 WRITE !,"If you want, you can transmit the DM extract data for these"
+36 WRITE !,"months by using the ""Manually Transmit DM Extract"" option."
End DoDot:1
+37 ;
+38 GOTO ENQ
+39 ;
XM(IBDT) ; - Create/transmit DM extract file message.
+1 ;
+2 NEW DA,DIE,DR,IB0,IB1,IBC,IBDT1,IBMG,IBSTE,X,XMDUZ,XMSUB,XMTEXT
+3 ;
+4 KILL ^TMP("DME",$JOB)
SET IBSTE=$$SITE^VASITE
SET X=$EXTRACT(DT,4,7)_(1700+$EXTRACT(DT,1,3))
+5 SET ^TMP("DME",$JOB,1)="HDR^"_$PIECE(IBSTE,U,3)_U_$PIECE(IBSTE,U,2)_U_X
+6 SET IBC=1
SET IB0=0
+7 FOR
SET IB0=$ORDER(^IBE(351.71,IBDT,1,IB0))
if 'IB0
QUIT
Begin DoDot:1
+8 ; No unbilled report needed
if IB0=37
QUIT
+9 SET X=$SELECT(IB0=8:$$M2^IBJDE(IBDT,5,3,1),1:$$M1^IBJDE(IBDT,2))
+10 SET IBC=IBC+1
SET ^TMP("DME",$JOB,IBC)="DAT~"_IB0_"~"_$PIECE(X,U)_"~"_$PIECE(X,U,2)
+11 SET IB1=0
FOR
SET IB1=$ORDER(^IBE(351.71,IBDT,1,IB0,1,IB1))
if 'IB1
QUIT
Begin DoDot:2
+12 SET X=$PIECE($GET(^IBE(351.71,IBDT,1,IB0,1,IB1,0)),U,2)
+13 SET ^TMP("DME",$JOB,IBC)=^TMP("DME",$JOB,IBC)_U_X
End DoDot:2
End DoDot:1
+14 ;
+15 SET ^TMP("DME",$JOB,IBC+1)="END^"_$PIECE(IBSTE,U,3)
SET IBDT1=$$M1^IBJDE(IBDT,3)
+16 SET XMSUB="DIAG. MEASURES EXTRACT FILE-"_IBDT1_" ("_$PIECE(IBSTE,U,2)_")"
+17 ;
+18 SET IBMG=$PIECE($GET(^IBE(350.9,1,4)),U,5)
IF IBMG=""
if '$GET(IBX)
GOTO ENQ
GOTO ENQ1
+19 ;
+20 SET XMDUZ="INTEGRATED BILLING PACKAGE"
+21 SET XMTEXT="^TMP(""DME"",$J,"
SET XMY(IBMG)=""
+22 DO SEND
+23 IF $GET(XMZ)
SET DIE="^IBE(351.71,"
SET DA=IBDT
SET DR=".05///1;.06///"_XMZ
DO ^DIE
+24 ;
+25 ; Return to DME manual transmit option.
IF $GET(IBX)
GOTO ENQ1
+26 ;
ENQ KILL IB2,IBDT2,IBD1,IBD2,IBDT,IBFL,IBFR,IBN,IBS,IBST,IBST1,IBX,IBX1,BY,DHD
+1 KILL DIC,DIOEND,FLDS,FR,IOP,L,TO,X,XMZ,Y,%
ENQ1 KILL IB0,IB1,IBC,IBDT1,IBMG,IBSTE,XMSUB,XMTEXT,XMY,^TMP("DME",$JOB)
+1 QUIT
+2 ;
SEND ; Calls ^XMD to send the mail message with the data extracted
+1 ; Obs: By NEWing DUZ, ^XMD will assume DUZ=.5 (Sender=POSTMASTER)
+2 ;
+3 NEW DUZ
DO ^XMD
+4 QUIT
