DGEN339 ;ALB/SCK - IVMB HEC CLEANUP - VETERAN MERGE EXTRACT ; 1/13/2001
;;5.3;Registration;**339,410**;Aug 13,1993
;
EN ; Main entry point for veteran merged pair collection and transmission to the HEC
N ZTRTN,ZTIO,ZTDESC,ZTSK,ZTDTH,ZTSAVE,DGDEST,DIR,DIRUT
;
; Check for merge of patient file in file #15.3
I '$D(^VA(15.3,2)) D Q
. W !?2,*7,">> There were no patient merge entries in the XDR REPOINTED ENTRY File (15.3)"
. W !?2,">> Please check that the Duplicate Patient Merge was completed."
;
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
;
S ZTSAVE("DGDEST")=""
S ZTRTN="QUE^DGEN339"
S ZTDESC="DG53_339 VETERAN MERGE GENERATION"
S ZTIO=""
S ZTDTH=$$NOW^XLFDT
D ^%ZTLOAD
;
I $G(ZTSK) W !,"Task Number: ",ZTSK
Q
;
QUE ;
N DGEXTRCT,DGDATA
;
S DGEXTRCT="^TMP(""DGEN VET MRG"",$J)"
K @DGEXTRCT
;
S DGDATA("SITE")=$P($$SITE^VASITE,U,3)
;
D COLLECT(DGEXTRCT,.DGDATA)
D BUILD(DGEXTRCT,.DGDATA,1000,DGDEST)
D NOTIFY(.DGDATA)
;
K @DGEXTRCT
Q
;
TEST(MODE) ; Test entry point for development testing. This entry point is not
; supported for user use.
;
N LINE,DGEXTRCT,DGDATA
;
S MODE=$G(MODE)
;
S DGDATA("TEST")=1
S DGEXTRCT="^TMP(""DGEN VET MRG"",$J)"
K @DGEXTRCT
;
S DGDATA("SITE")=$P($$SITE^VASITE,U,3)
;
I 'MODE D
. F LINE=1:1:1200 D
. . S @DGEXTRCT@(LINE)=$R(2000)_"^"_$R(2000)
. S DGDATA("NUMREC")=LINE
E D
. D COLLECT(DGEXTRCT,.DGDATA)
;
D BUILD(DGEXTRCT,.DGDATA,500)
D NOTIFY(.DGDATA)
;
K @DGEXTRCT
Q
;
COLLECT(DGEXTRCT,DGDATA) ; Collect Merge From and Merge To pair from XDR Repointed Entry File
; Append ICN to end of merge pair using API call
N LINE,IX,ZVALUE,DFN1,DFN2
;
S IX=0,LINE=1
F S IX=$O(^VA(15.3,2,1,IX)) Q:'IX D
. S ZVALUE=$G(^VA(15.3,2,1,IX,0))
. I ($T(GETICN^MPIF001)'="") D
. . S DFN1=$P(ZVALUE,U)
. . S DFN2=$P(ZVALUE,U,2)
. . S ZVALUE=ZVALUE_U_"M~"_$$GETICN^MPIF001(DFN1)_U_"MT~"_$$GETICN^MPIF001(DFN2)
. S @DGEXTRCT@(LINE)=ZVALUE
. S LINE=LINE+1
S DGDATA("NUMREC")=LINE-1
;
Q
;
BUILD(DGEXTRCT,DGDATA,MAX,DGDEST) ; Build and send mailman messages of veteran pairs
N DGX,COUNT,DGMSG,LINE
;
S MAX=$G(MAX)
S:'MAX MAX=1000
;
S DGMSG="^TMP(""DG339TXT"",$J)"
K @DGMSG
;
; Calculate the number of messages to send using MAX and number of records
S DGDATA("TOSEND")=DGDATA("NUMREC")\MAX
S:DGDATA("NUMREC")#MAX>0 DGDATA("TOSEND")=DGDATA("TOSEND")+1
;
S DGDATA("MSGNUM")=1 ; Initialize first message
S COUNT=0,LINE=1
F S COUNT=$O(@DGEXTRCT@(COUNT)) Q:'COUNT D
. S @DGMSG@(LINE)=@DGEXTRCT@(COUNT)
. S LINE=LINE+1
. I LINE>MAX D
. . S DGDATA("MSG",DGDATA("MSGNUM"))=LINE-1
. . D SEND(.DGDATA,DGMSG,DGDEST)
. . S DGDATA("MSGNUM")=$G(DGDATA("MSGNUM"))+1
. . K @DGMSG
. . S LINE=1
; Send last message
S DGDATA("MSG",DGDATA("MSGNUM"))=LINE-1
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 VETERAN MERGE EXTRACT"
I $G(DGDEST) S XMY("S.IVMB VSE SERVER@IVM.DOMAIN.EXT")=""
E S XMY("S.IVMB VSE SERVER@PDQMGR.IVM.DOMAIN.EXT")=""
;
S XMY(.5)=""
S XMY("G.IVMB HEC VSE NOTIFICATION")=""
S XMSUB=$$GET1^DIQ(4,DGDATA("SITE"),.01)_"/"_DGDATA("SITE")_":VSE #"_DGDATA("MSGNUM")_" OF "_DGDATA("TOSEND")
S @DGMSG@(.5)=DGDATA("SITE")_U_DGDATA("MSGNUM")_U_DGDATA("TOSEND")_U_DGDATA("MSG",DGDATA("MSGNUM"))_"^"_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 VETERAN MERGE EXTRACT"
S XMY("G.IVMB HEC VSE NOTIFICATION")=""
S XMSUB="HEC VETERAN MERGE EXTRACT TRANSMISSION"
;
S DGTXT(.1)="A total of "_DGDATA("NUMREC")_" veteran extract 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[HDGEN339 4317 printed Oct 16, 2024@18:42:51 Page 2
DGEN339 ;ALB/SCK - IVMB HEC CLEANUP - VETERAN MERGE EXTRACT ; 1/13/2001
+1 ;;5.3;Registration;**339,410**;Aug 13,1993
+2 ;
EN ; Main entry point for veteran merged pair collection and transmission to the HEC
+1 NEW ZTRTN,ZTIO,ZTDESC,ZTSK,ZTDTH,ZTSAVE,DGDEST,DIR,DIRUT
+2 ;
+3 ; Check for merge of patient file in file #15.3
+4 IF '$DATA(^VA(15.3,2))
Begin DoDot:1
+5 WRITE !?2,*7,">> There were no patient merge entries in the XDR REPOINTED ENTRY File (15.3)"
+6 WRITE !?2,">> Please check that the Duplicate Patient Merge was completed."
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 SET DGDEST=+Y
+14 ;
+15 SET ZTSAVE("DGDEST")=""
+16 SET ZTRTN="QUE^DGEN339"
+17 SET ZTDESC="DG53_339 VETERAN MERGE GENERATION"
+18 SET ZTIO=""
+19 SET ZTDTH=$$NOW^XLFDT
+20 DO ^%ZTLOAD
+21 ;
+22 IF $GET(ZTSK)
WRITE !,"Task Number: ",ZTSK
+23 QUIT
+24 ;
QUE ;
+1 NEW DGEXTRCT,DGDATA
+2 ;
+3 SET DGEXTRCT="^TMP(""DGEN VET MRG"",$J)"
+4 KILL @DGEXTRCT
+5 ;
+6 SET DGDATA("SITE")=$PIECE($$SITE^VASITE,U,3)
+7 ;
+8 DO COLLECT(DGEXTRCT,.DGDATA)
+9 DO BUILD(DGEXTRCT,.DGDATA,1000,DGDEST)
+10 DO NOTIFY(.DGDATA)
+11 ;
+12 KILL @DGEXTRCT
+13 QUIT
+14 ;
TEST(MODE) ; Test entry point for development testing. This entry point is not
+1 ; supported for user use.
+2 ;
+3 NEW LINE,DGEXTRCT,DGDATA
+4 ;
+5 SET MODE=$GET(MODE)
+6 ;
+7 SET DGDATA("TEST")=1
+8 SET DGEXTRCT="^TMP(""DGEN VET MRG"",$J)"
+9 KILL @DGEXTRCT
+10 ;
+11 SET DGDATA("SITE")=$PIECE($$SITE^VASITE,U,3)
+12 ;
+13 IF 'MODE
Begin DoDot:1
+14 FOR LINE=1:1:1200
Begin DoDot:2
+15 SET @DGEXTRCT@(LINE)=$RANDOM(2000)_"^"_$RANDOM(2000)
End DoDot:2
+16 SET DGDATA("NUMREC")=LINE
End DoDot:1
+17 IF '$TEST
Begin DoDot:1
+18 DO COLLECT(DGEXTRCT,.DGDATA)
End DoDot:1
+19 ;
+20 DO BUILD(DGEXTRCT,.DGDATA,500)
+21 DO NOTIFY(.DGDATA)
+22 ;
+23 KILL @DGEXTRCT
+24 QUIT
+25 ;
COLLECT(DGEXTRCT,DGDATA) ; Collect Merge From and Merge To pair from XDR Repointed Entry File
+1 ; Append ICN to end of merge pair using API call
+2 NEW LINE,IX,ZVALUE,DFN1,DFN2
+3 ;
+4 SET IX=0
SET LINE=1
+5 FOR
SET IX=$ORDER(^VA(15.3,2,1,IX))
if 'IX
QUIT
Begin DoDot:1
+6 SET ZVALUE=$GET(^VA(15.3,2,1,IX,0))
+7 IF ($TEXT(GETICN^MPIF001)'="")
Begin DoDot:2
+8 SET DFN1=$PIECE(ZVALUE,U)
+9 SET DFN2=$PIECE(ZVALUE,U,2)
+10 SET ZVALUE=ZVALUE_U_"M~"_$$GETICN^MPIF001(DFN1)_U_"MT~"_$$GETICN^MPIF001(DFN2)
End DoDot:2
+11 SET @DGEXTRCT@(LINE)=ZVALUE
+12 SET LINE=LINE+1
End DoDot:1
+13 SET DGDATA("NUMREC")=LINE-1
+14 ;
+15 QUIT
+16 ;
BUILD(DGEXTRCT,DGDATA,MAX,DGDEST) ; Build and send mailman messages of veteran pairs
+1 NEW DGX,COUNT,DGMSG,LINE
+2 ;
+3 SET MAX=$GET(MAX)
+4 if 'MAX
SET MAX=1000
+5 ;
+6 SET DGMSG="^TMP(""DG339TXT"",$J)"
+7 KILL @DGMSG
+8 ;
+9 ; Calculate the number of messages to send using MAX and number of records
+10 SET DGDATA("TOSEND")=DGDATA("NUMREC")\MAX
+11 if DGDATA("NUMREC")#MAX>0
SET DGDATA("TOSEND")=DGDATA("TOSEND")+1
+12 ;
+13 ; Initialize first message
SET DGDATA("MSGNUM")=1
+14 SET COUNT=0
SET LINE=1
+15 FOR
SET COUNT=$ORDER(@DGEXTRCT@(COUNT))
if 'COUNT
QUIT
Begin DoDot:1
+16 SET @DGMSG@(LINE)=@DGEXTRCT@(COUNT)
+17 SET LINE=LINE+1
+18 IF LINE>MAX
Begin DoDot:2
+19 SET DGDATA("MSG",DGDATA("MSGNUM"))=LINE-1
+20 DO SEND(.DGDATA,DGMSG,DGDEST)
+21 SET DGDATA("MSGNUM")=$GET(DGDATA("MSGNUM"))+1
+22 KILL @DGMSG
+23 SET LINE=1
End DoDot:2
End DoDot:1
+24 ; Send last message
+25 SET DGDATA("MSG",DGDATA("MSGNUM"))=LINE-1
+26 DO SEND(.DGDATA,DGMSG,DGDEST)
+27 ;
+28 QUIT
+29 ;
SEND(DGDATA,DGMSG,DGDEST) ; Build and send individual mailman messages
+1 NEW XMY,XMSUB,XMDUZ,XMZ,XMERR,XMTEXT,MSG
+2 ;
+3 SET XMDUZ="HEC VETERAN MERGE EXTRACT"
+4 IF $GET(DGDEST)
SET XMY("S.IVMB VSE SERVER@IVM.DOMAIN.EXT")=""
+5 IF '$TEST
SET XMY("S.IVMB VSE SERVER@PDQMGR.IVM.DOMAIN.EXT")=""
+6 ;
+7 SET XMY(.5)=""
+8 SET XMY("G.IVMB HEC VSE NOTIFICATION")=""
+9 SET XMSUB=$$GET1^DIQ(4,DGDATA("SITE"),.01)_"/"_DGDATA("SITE")_":VSE #"_DGDATA("MSGNUM")_" OF "_DGDATA("TOSEND")
+10 SET @DGMSG@(.5)=DGDATA("SITE")_U_DGDATA("MSGNUM")_U_DGDATA("TOSEND")_U_DGDATA("MSG",DGDATA("MSGNUM"))_"^"_DGDATA("NUMREC")
+11 SET XMTEXT="MSG("
+12 MERGE MSG=@DGMSG
+13 ;
+14 DO ^XMD
+15 QUIT
+16 ;
NOTIFY(DGDATA) ; Send notification message to local mailgroup.
+1 NEW XMY,XMSUB,XMTEXT,XMDUZ,XMZ,XMERR,DGTXT
+2 ;
+3 SET XMDUZ="HEC VETERAN MERGE EXTRACT"
+4 SET XMY("G.IVMB HEC VSE NOTIFICATION")=""
+5 SET XMSUB="HEC VETERAN MERGE EXTRACT TRANSMISSION"
+6 ;
+7 SET DGTXT(.1)="A total of "_DGDATA("NUMREC")_" veteran extract 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 DO ^XMD
+16 QUIT
