151 lines
4.1 KiB
Mathematica
151 lines
4.1 KiB
Mathematica
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.MED.VA.GOV")=""
|
|
E S XMY("S.IVMB VSE SERVER@PDQMGR.IVM.MED.VA.GOV")=""
|
|
;
|
|
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
|