- 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 Feb 19, 2025@00:08:15 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