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