DGEN408 ;ALB/RKS - SEED THE HEC ; 5/3/02 3:04pm
;;5.3;Registration;**408**;Aug 13,1993
Q
;
EN ; Main entry point for collection of MPI fields & transmission to HEC
;
N ZTRTN,ZTIO,ZTDESC,ZTSK,ZTDTH,ZTSAVE,DGDEST,DIR,DIRUT
;
; Check for MPI
I ($T(GETICN^MPIF001)="") D Q
. W !?2,*7,">> There were no patient MPI"
;
S DIR(0)="YAO",DIR("B")="YES",DIR("A")="Transmit to HEC Production? "
S DIR("?",1)="'YES' will transmit extracts to the HEC production system."
S DIR("?")="'NO' will transmit the extracts to the HEC Development accounts."
D ^DIR K DIR
Q:$D(DIRUT)
S DGDEST=+Y ;Destination = 1 for Production
I 'DGDEST D TEST Q ;else Test Mode and Quit
;
S ZTSAVE("DGDEST")=""
S ZTRTN="QUE^DGEN408"
S ZTDESC="DG53_408 SEED THE HEC WITH ICN"
S ZTIO=""
S ZTDTH=$$NOW^XLFDT
D ^%ZTLOAD
;
I $G(ZTSK) W !,"Task Number: ",ZTSK
Q
;
QUE ;Background task entry point for Production option
N DGEXTRCT,DGDATA
;
S DGEXTRCT="^TMP(""SEED HEC"",$J)"
K @DGEXTRCT
;
S DGDATA("SITE")=$P($$SITE^VASITE,U,3)
K IVMQUERY("LTD"),IVMQUERY("OVIS")
;
D COLLECT(DGEXTRCT,.DGDATA)
D BUILD(DGEXTRCT,.DGDATA,1000,DGDEST)
D NOTIFY(.DGDATA)
;
K @DGEXTRCT
Q
;
TEST ; Test entry point for development testing. This entry point is
; not supported for user use.
N LINE,DGEXTRCT,DGDATA
K DIR
S DIR(0)="SO^P:PDQMGR ENV;S:SDQMGR ENV;Q:QDQMGR ENV"
S DIR("A")="Transmit to which Environment? "
S DIR("?")="Enter 1 of the 3 test environments allowed"
D ^DIR K DIR Q:$D(DIRUT)
S DGDEST=Y ;Destination = P, S, or Q for testing
S DGDATA("TEST")=1
S DGEXTRCT="^TMP(""SEED HEC"",$J)"
K @DGEXTRCT
S DGDATA("SITE")=$P($$SITE^VASITE,U,3)
;
W !!,"COLLECTING DATA TO SEND TO "_DGDEST_"DQMGR...please wait..."
D COLLECT(DGEXTRCT,.DGDATA)
D BUILD(DGEXTRCT,.DGDATA,1000,DGDEST) ;batch 1000 vets per message
D NOTIFY(.DGDATA)
;
K @DGEXTRCT
Q
;
COLLECT(DGEXTRCT,DGDATA) ; Collect valid MPI data
N LINE,DFN
;
S DFN=0,LINE=1
;
;loop and set TMP extract global with patients that qualify, ignoring
;those patients whose CMOR is not from this site or have a Local ICN
F S DFN=$O(^DPT(DFN)) Q:'DFN D
. I +$$GETICN^MPIF001(DFN)<0!(($$IFLOCAL^MPIF001(DFN)=1)!($$IFVCCI^MPIF001(DFN)'=1)) Q
. S @DGEXTRCT@(LINE)=DFN_U_$$GETICN^MPIF001(DFN)_U
. S @DGEXTRCT@(LINE)=@DGEXTRCT@(LINE)_$$GETVCCI^MPIF001(DFN)
. S LINE=LINE+1
;
S DGDATA("NUMREC")=LINE-1
;
Q
;
BUILD(DGEXTRCT,DGDATA,MAX,DGDEST) ; Build mailman messages of MPI data
N DGX,COUNT,DGMSG,LINE
;
S MAX=$G(MAX)
S:'MAX MAX=1000
;
S DGMSG="^TMP(""DGEN408TXT"",$J)"
K @DGMSG
;
; Calculate the number of messages (batches) to send based on MAX
S DGDATA("TOSEND")=DGDATA("NUMREC")\MAX
S:DGDATA("NUMREC")#MAX>0 DGDATA("TOSEND")=DGDATA("TOSEND")+1
;
S (COUNT,LINE)=0
F S COUNT=$O(@DGEXTRCT@(COUNT)) Q:'COUNT D
. S LINE=LINE+1
. S @DGMSG@(LINE)=@DGEXTRCT@(COUNT)
. ; if exceed max per batch, then stop and send now & reset for next
. I LINE=MAX D
. . S DGDATA("MSGNUM")=$G(DGDATA("MSGNUM"))+1
. . S DGDATA("MSG",DGDATA("MSGNUM"))=LINE
. . D SEND(.DGDATA,DGMSG,DGDEST)
. . K @DGMSG
. . S LINE=0
;
; Quit if Not at least 1 record exists, else send last batch
Q:'LINE
;
;send the last partial batch
S DGDATA("MSGNUM")=$G(DGDATA("MSGNUM"))+1
S DGDATA("MSG",DGDATA("MSGNUM"))=LINE
D SEND(.DGDATA,DGMSG,DGDEST)
;
Q
;
SEND(DGDATA,DGMSG,DGDEST) ; Build and send individual mailman messages
N XMY,XMSUB,XMDUZ,XMZ,XMERR,XMTEXT,MSG
;
S XMDUZ="HEC MPI SEEDING"
I DGDEST=1 D ;send to production
. S XMY("S.IVMB MPI SERVER@IVM.DOMAIN.EXT")=""
E D ;send to a test account
. N TMP
. S TMP="S.IVMB MPI SERVER@"_DGDEST_"DQMGR.IVM.DOMAIN.EXT"
. S XMY(TMP)=""
;
S XMY(.5)=""
S XMY("G.IVMB HEC MPI NOTIFICATION")=""
S XMSUB=$$GET1^DIQ(4,DGDATA("SITE"),.01)_"/"_DGDATA("SITE")
S XMSUB=XMSUB_":MPI #"_DGDATA("MSGNUM")_" OF "_DGDATA("TOSEND")
S @DGMSG@(.5)=DGDATA("SITE")_U_DGDATA("MSGNUM")_U_DGDATA("TOSEND")
S @DGMSG@(.5)=@DGMSG@(.5)_U_DGDATA("MSG",DGDATA("MSGNUM"))_U
S @DGMSG@(.5)=@DGMSG@(.5)_DGDATA("NUMREC")
S XMTEXT="MSG("
M MSG=@DGMSG
;
D ^XMD
Q
;
NOTIFY(DGDATA) ; Send notification message to local mailgroup.
N XMY,XMSUB,XMTEXT,XMDUZ,XMZ,XMERR,DGTXT
;
S XMDUZ="HEC MPI SEEDING"
S XMY("G.IVMB HEC MPI NOTIFICATION")=""
S XMSUB="HEC MPI TRANSMISSION"
;
S DGTXT(.1)="A total of "_DGDATA("NUMREC")_" MPI seeding records in "_DGDATA("MSGNUM")
S DGTXT(.2)="messages have been transmitted to the HEC"
S DGTXT(.3)=""
;
S X=0
F S X=$O(DGDATA("MSG",X)) Q:'X D
. S DGTXT(X)=" Message #"_X_" - "_DGDATA("MSG",X)_" records"
S XMTEXT="DGTXT("
;
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGEN408 4838 printed Oct 16, 2024@18:42:52 Page 2
DGEN408 ;ALB/RKS - SEED THE HEC ; 5/3/02 3:04pm
+1 ;;5.3;Registration;**408**;Aug 13,1993
+2 QUIT
+3 ;
EN ; Main entry point for collection of MPI fields & transmission to HEC
+1 ;
+2 NEW ZTRTN,ZTIO,ZTDESC,ZTSK,ZTDTH,ZTSAVE,DGDEST,DIR,DIRUT
+3 ;
+4 ; Check for MPI
+5 IF ($TEXT(GETICN^MPIF001)="")
Begin DoDot:1
+6 WRITE !?2,*7,">> There were no patient MPI"
End DoDot:1
QUIT
+7 ;
+8 SET DIR(0)="YAO"
SET DIR("B")="YES"
SET DIR("A")="Transmit to HEC Production? "
+9 SET DIR("?",1)="'YES' will transmit extracts to the HEC production system."
+10 SET DIR("?")="'NO' will transmit the extracts to the HEC Development accounts."
+11 DO ^DIR
KILL DIR
+12 if $DATA(DIRUT)
QUIT
+13 ;Destination = 1 for Production
SET DGDEST=+Y
+14 ;else Test Mode and Quit
IF 'DGDEST
DO TEST
QUIT
+15 ;
+16 SET ZTSAVE("DGDEST")=""
+17 SET ZTRTN="QUE^DGEN408"
+18 SET ZTDESC="DG53_408 SEED THE HEC WITH ICN"
+19 SET ZTIO=""
+20 SET ZTDTH=$$NOW^XLFDT
+21 DO ^%ZTLOAD
+22 ;
+23 IF $GET(ZTSK)
WRITE !,"Task Number: ",ZTSK
+24 QUIT
+25 ;
QUE ;Background task entry point for Production option
+1 NEW DGEXTRCT,DGDATA
+2 ;
+3 SET DGEXTRCT="^TMP(""SEED HEC"",$J)"
+4 KILL @DGEXTRCT
+5 ;
+6 SET DGDATA("SITE")=$PIECE($$SITE^VASITE,U,3)
+7 KILL IVMQUERY("LTD"),IVMQUERY("OVIS")
+8 ;
+9 DO COLLECT(DGEXTRCT,.DGDATA)
+10 DO BUILD(DGEXTRCT,.DGDATA,1000,DGDEST)
+11 DO NOTIFY(.DGDATA)
+12 ;
+13 KILL @DGEXTRCT
+14 QUIT
+15 ;
TEST ; Test entry point for development testing. This entry point is
+1 ; not supported for user use.
+2 NEW LINE,DGEXTRCT,DGDATA
+3 KILL DIR
+4 SET DIR(0)="SO^P:PDQMGR ENV;S:SDQMGR ENV;Q:QDQMGR ENV"
+5 SET DIR("A")="Transmit to which Environment? "
+6 SET DIR("?")="Enter 1 of the 3 test environments allowed"
+7 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+8 ;Destination = P, S, or Q for testing
SET DGDEST=Y
+9 SET DGDATA("TEST")=1
+10 SET DGEXTRCT="^TMP(""SEED HEC"",$J)"
+11 KILL @DGEXTRCT
+12 SET DGDATA("SITE")=$PIECE($$SITE^VASITE,U,3)
+13 ;
+14 WRITE !!,"COLLECTING DATA TO SEND TO "_DGDEST_"DQMGR...please wait..."
+15 DO COLLECT(DGEXTRCT,.DGDATA)
+16 ;batch 1000 vets per message
DO BUILD(DGEXTRCT,.DGDATA,1000,DGDEST)
+17 DO NOTIFY(.DGDATA)
+18 ;
+19 KILL @DGEXTRCT
+20 QUIT
+21 ;
COLLECT(DGEXTRCT,DGDATA) ; Collect valid MPI data
+1 NEW LINE,DFN
+2 ;
+3 SET DFN=0
SET LINE=1
+4 ;
+5 ;loop and set TMP extract global with patients that qualify, ignoring
+6 ;those patients whose CMOR is not from this site or have a Local ICN
+7 FOR
SET DFN=$ORDER(^DPT(DFN))
if 'DFN
QUIT
Begin DoDot:1
+8 IF +$$GETICN^MPIF001(DFN)<0!(($$IFLOCAL^MPIF001(DFN)=1)!($$IFVCCI^MPIF001(DFN)'=1))
QUIT
+9 SET @DGEXTRCT@(LINE)=DFN_U_$$GETICN^MPIF001(DFN)_U
+10 SET @DGEXTRCT@(LINE)=@DGEXTRCT@(LINE)_$$GETVCCI^MPIF001(DFN)
+11 SET LINE=LINE+1
End DoDot:1
+12 ;
+13 SET DGDATA("NUMREC")=LINE-1
+14 ;
+15 QUIT
+16 ;
BUILD(DGEXTRCT,DGDATA,MAX,DGDEST) ; Build mailman messages of MPI data
+1 NEW DGX,COUNT,DGMSG,LINE
+2 ;
+3 SET MAX=$GET(MAX)
+4 if 'MAX
SET MAX=1000
+5 ;
+6 SET DGMSG="^TMP(""DGEN408TXT"",$J)"
+7 KILL @DGMSG
+8 ;
+9 ; Calculate the number of messages (batches) to send based on MAX
+10 SET DGDATA("TOSEND")=DGDATA("NUMREC")\MAX
+11 if DGDATA("NUMREC")#MAX>0
SET DGDATA("TOSEND")=DGDATA("TOSEND")+1
+12 ;
+13 SET (COUNT,LINE)=0
+14 FOR
SET COUNT=$ORDER(@DGEXTRCT@(COUNT))
if 'COUNT
QUIT
Begin DoDot:1
+15 SET LINE=LINE+1
+16 SET @DGMSG@(LINE)=@DGEXTRCT@(COUNT)
+17 ; if exceed max per batch, then stop and send now & reset for next
+18 IF LINE=MAX
Begin DoDot:2
+19 SET DGDATA("MSGNUM")=$GET(DGDATA("MSGNUM"))+1
+20 SET DGDATA("MSG",DGDATA("MSGNUM"))=LINE
+21 DO SEND(.DGDATA,DGMSG,DGDEST)
+22 KILL @DGMSG
+23 SET LINE=0
End DoDot:2
End DoDot:1
+24 ;
+25 ; Quit if Not at least 1 record exists, else send last batch
+26 if 'LINE
QUIT
+27 ;
+28 ;send the last partial batch
+29 SET DGDATA("MSGNUM")=$GET(DGDATA("MSGNUM"))+1
+30 SET DGDATA("MSG",DGDATA("MSGNUM"))=LINE
+31 DO SEND(.DGDATA,DGMSG,DGDEST)
+32 ;
+33 QUIT
+34 ;
SEND(DGDATA,DGMSG,DGDEST) ; Build and send individual mailman messages
+1 NEW XMY,XMSUB,XMDUZ,XMZ,XMERR,XMTEXT,MSG
+2 ;
+3 SET XMDUZ="HEC MPI SEEDING"
+4 ;send to production
IF DGDEST=1
Begin DoDot:1
+5 SET XMY("S.IVMB MPI SERVER@IVM.DOMAIN.EXT")=""
End DoDot:1
+6 ;send to a test account
IF '$TEST
Begin DoDot:1
+7 NEW TMP
+8 SET TMP="S.IVMB MPI SERVER@"_DGDEST_"DQMGR.IVM.DOMAIN.EXT"
+9 SET XMY(TMP)=""
End DoDot:1
+10 ;
+11 SET XMY(.5)=""
+12 SET XMY("G.IVMB HEC MPI NOTIFICATION")=""
+13 SET XMSUB=$$GET1^DIQ(4,DGDATA("SITE"),.01)_"/"_DGDATA("SITE")
+14 SET XMSUB=XMSUB_":MPI #"_DGDATA("MSGNUM")_" OF "_DGDATA("TOSEND")
+15 SET @DGMSG@(.5)=DGDATA("SITE")_U_DGDATA("MSGNUM")_U_DGDATA("TOSEND")
+16 SET @DGMSG@(.5)=@DGMSG@(.5)_U_DGDATA("MSG",DGDATA("MSGNUM"))_U
+17 SET @DGMSG@(.5)=@DGMSG@(.5)_DGDATA("NUMREC")
+18 SET XMTEXT="MSG("
+19 MERGE MSG=@DGMSG
+20 ;
+21 DO ^XMD
+22 QUIT
+23 ;
NOTIFY(DGDATA) ; Send notification message to local mailgroup.
+1 NEW XMY,XMSUB,XMTEXT,XMDUZ,XMZ,XMERR,DGTXT
+2 ;
+3 SET XMDUZ="HEC MPI SEEDING"
+4 SET XMY("G.IVMB HEC MPI NOTIFICATION")=""
+5 SET XMSUB="HEC MPI TRANSMISSION"
+6 ;
+7 SET DGTXT(.1)="A total of "_DGDATA("NUMREC")_" MPI seeding records in "_DGDATA("MSGNUM")
+8 SET DGTXT(.2)="messages have been transmitted to the HEC"
+9 SET DGTXT(.3)=""
+10 ;
+11 SET X=0
+12 FOR
SET X=$ORDER(DGDATA("MSG",X))
if 'X
QUIT
Begin DoDot:1
+13 SET DGTXT(X)=" Message #"_X_" - "_DGDATA("MSG",X)_" records"
End DoDot:1
+14 SET XMTEXT="DGTXT("
+15 ;
+16 DO ^XMD
+17 QUIT
