Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGEN408

DGEN408.m

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