- 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 Jan 18, 2025@03:23:54 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