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

DG53P379.m

Go to the documentation of this file. 
  1. DG53P379 ;ALB/RPM,RBS - Patch DG*5.3*379 Install Utility Routine ; 2/4/02 12:38pm
  1.  ;;5.3;Registration;**379,1015**;Aug 13, 1993;Build 21
  1.  ;
  1.  ; This routine will provide the following:
  1.  ; 1. The MST HISTORY file (#29.11) will have a new field added.
  1.  ;    - Field (#6) - Site Determining Status
  1.  ; 2. Create a New-Style compound Cross-Reference "APDT" in the MST
  1.  ;    HISTORY file (#29.11) using Fields (#.01) and (#2).
  1.  ; 3. Setup TaskMan Job for background processing
  1.  ; 4. The most current patient MST info will be queued for
  1.  ;    transmission to the HEC via the Enrollment HL7 Z07 processing.
  1.  ;   * NOTE:  ALPHA Test Sites will not re-send HL7 msg's to the HEC.
  1.  ; 5. Generate a mail message to the User that ran the install.
  1.  ;
  1. ENV ;Main entry point for Environment check point.
  1.  ;
  1.  S XPDABORT=""
  1.  D PROGCHK(.XPDABORT) ;checks programmer variables
  1.  Q:+XPDABORT
  1.  ;
  1.  ; Check for the initial CPRS Synchronization run date
  1.  D CPRS(.XPDABORT)
  1.  ;
  1.  I XPDABORT="" K XPDABORT
  1.  Q
  1.  ;
  1. PRE ;Main entry point for Pre-init items.
  1.  ;
  1.  Q
  1.  ;
  1. POST ;Main entry point for Post-init items.
  1.  ;
  1.  D POST1         ;remove traditional APDT xref from .01 & 2
  1.  D POST2         ;re-create "APDT" cross reference
  1.  D POST3         ;Setup TaskMan Job
  1.  ;               ;enter local station number in new SITE field (#6)
  1.  Q
  1.  ;
  1. POST1 ;Delete the broken "APDT" traditional MUMPS xref from the data
  1.  ; dictionary.
  1.  ;Kill the "APDT" index from the MST HISTORY file(#29.11) to prepare
  1.  ; for the 'new' style "APDT" xref and re-index.
  1.  ;
  1.  ;Check Data Dictionary to see if already changed to New Style xref
  1.  I '$D(^DD(29.11,.01,1,2)),'$D(^DD(29.11,2,1,1)) D  Q
  1.  .D BMES^XPDUTL(" NO Traditional 'APDT' x-ref found in the MST HISTORY file(#29.11) to Delete.")
  1.  ;
  1.  D BMES^XPDUTL(" Deleting the Traditional 'APDT' cross reference from the")
  1.  D MES^XPDUTL(" MST HISTORY file(#29.11) to prepare for the 'New Style'")
  1.  D MES^XPDUTL(" 'APDT' cross reference installation.")
  1.  D DELIX^DDMOD(29.11,.01,2)
  1.  D DELIX^DDMOD(29.11,2,1)
  1.  I '$D(^DD(29.11,.01,1,2)),'$D(^DD(29.11,2,1,1)) D
  1.  .K ^DGMS(29.11,"APDT")  ;FileMan won't kill all of "APDT" nodes.
  1.  .D BMES^XPDUTL(" Traditional 'APDT' cross reference successfully removed.")
  1.  Q
  1.  ;
  1. POST2 ;This POST install routine will re-create the "APDT" cross
  1.  ; reference by re-indexing field .01.
  1.  ;
  1.  I $D(^DGMS(29.11,"APDT")) D  Q   ;don't re-index if found
  1.  .D BMES^XPDUTL(" NO re-indexing necessary for the MST HISTORY file(#29.11) 'APDT' x-ref.")
  1.  ;
  1.  N DIK,X
  1.  D BMES^XPDUTL(" Please be patient while I re-create the 'APDT' cross reference.")
  1.  S DIK="^DGMS(29.11,",DIK(1)=".01^APDT"
  1.  D ENALL^DIK
  1.  I $D(^DGMS(29.11,"APDT")) D  Q
  1.  .D BMES^XPDUTL(" The MST HISTORY file(#29.11) 'APDT' x-ref was successfully re-created.")
  1.  Q
  1.  ;
  1. POST3 ;Set up TaskMan to process in the background
  1.  ;
  1.  N DGDFN,ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
  1.  S ZTRTN="SCAN^DG53P379"
  1.  S ZTDESC="Process MST records for DG*5.3*379"
  1.  ;Queue Task to start in 60 seconds
  1.  S ZTDTH=$$SCH^XLFDT("60S",$$NOW^XLFDT)
  1.  S ZTIO=""
  1.  I $G(^XTMP("DG53P379","LASTDFN"))>0 D
  1.  . S DGDFN=^XTMP("DG53P379","LASTDFN"),ZTSAVE("DGDFN")=""
  1.  D ^%ZTLOAD
  1.  D BMES^XPDUTL("*****")
  1.  D
  1.  . I $D(ZTSK)[0 D  Q
  1.  . . D MES^XPDUTL("TaskMan run to Process MST records for DG*5.3*379 was not started.")
  1.  . . D MES^XPDUTL("Re-run Post Install routine POST3^DG53P379.")
  1.  . I $D(ZTSK("D")) D
  1.  . . I '$D(DGDFN) D  Q
  1.  . . . D MES^XPDUTL("Task will start at "_$$HTE^XLFDT(ZTSK("D")))
  1.  . . D MES^XPDUTL("Task will re-start with DFN: "_DGDFN_" at "_$$HTE^XLFDT(ZTSK("D")))
  1.  D MES^XPDUTL("*****")
  1.  Q
  1.  ;
  1. SCAN ;This POST install routine will load the local site's station number
  1.  ; as a pointer to the INSTITUTION file (#4) in the SITE field (#6) of
  1.  ;  the MST HISTORY file (#29.11).
  1.  ;
  1.  N DGDAT,DGFDA,DGERR,DGMSG
  1.  N DGSTART                ;Job start date/time
  1.  N DGQUIT                 ;Job control flag
  1.  N DGIEN                  ;MST HISTORY file IEN
  1.  N DGOSITE                ;existing SITE field data
  1.  N DGSITE                 ;SITE value to be stuffed
  1.  N DGCNT                  ;counter of records
  1.  N DGTCNT                 ;number of patients scanned
  1.  ;
  1.  I +$G(DGDFN)'>0 S DGDFN=0
  1.  S DGSTART=$$NOW^XLFDT,ZTREQ="@"  ;START dt/delete task when finished
  1.  S (DGCNT,DGTCNT,DGQUIT,DGMSG)=0
  1.  S ^XTMP("DG53P379",0)=$$FMADD^XLFDT(""_DT_"",60)_U_DT_U_"MST BASELINE SEEDING"
  1.  ;
  1.  S DGSITE=$P($$SITE^VASITE,U)
  1.  I +DGSITE'>0 D  Q                ;*** ERROR CONDITION ***
  1.  .S DGMSG=2
  1.  .S DGMSG(1)=" Invalid Station number - Stopping Taskman Job"
  1.  .S DGMSG(2)=" Re-run Post Install routine POST3^DG53P379."
  1.  .D MSG(DGSTART,DGTCNT,DGCNT,.DGMSG)
  1.  ;
  1.  F  S DGDFN=$O(^DGMS(29.11,"APDT",DGDFN)) Q:'DGDFN  D  Q:DGQUIT
  1.  .S DGTCNT=DGTCNT+1
  1.  .I DGTCNT#60=0,$$S^%ZTLOAD D  Q
  1.  ..S DGMSG=2
  1.  ..S DGMSG(1)=" Patch DG*5.3*379 MST Task "_ZTSK_" Stopped by User"
  1.  ..S DGMSG(2)=" Re-run Post Install routine POST3^DG53P379."
  1.  ..D MSG(DGSTART,DGTCNT,DGCNT,.DGMSG)
  1.  ..S (ZTSTOP,DGQUIT)=1
  1.  .S DGDAT=0
  1.  .F  S DGDAT=$O(^DGMS(29.11,"APDT",DGDFN,DGDAT)) Q:'DGDAT  D
  1.  ..S DGIEN=0
  1.  ..F  S DGIEN=$O(^DGMS(29.11,"APDT",DGDFN,DGDAT,DGIEN)) Q:'DGIEN  D
  1.  ...K DGERR,DGFDA
  1.  ...S DGOSITE=$$GET1^DIQ(29.11,DGIEN_",",6,"I","",.DGERR)
  1.  ...Q:$D(DGERR)
  1.  ...I DGOSITE=""  D                    ;site FIELD not setup ***
  1.  ....S DGFDA(29.11,DGIEN_",",6)=DGSITE
  1.  ....D FILE^DIE("I","DGFDA","DGERR")   ;file site pointer to (#29.11)
  1.  .; *** Don't re-queue entry for HEC HL7 if Alpha Test Site:  ***
  1.  .;     (437) FARGO VAMRO
  1.  .;     (537) CHICAGO HCS
  1.  .;     (612) NORTHERN CALIFORNIA HCS
  1.  .I ",437,537,612,"'[(","_$P($$SITE^VASITE,U,3)_",") D XMIT(DGDFN)
  1.  .S ^XTMP("DG53P379","LASTDFN")=DGDFN
  1.  ;
  1.  I 'DGQUIT D MSG(DGSTART,DGTCNT,DGCNT,"")  ;create mailman msg to user
  1.  Q
  1.  ;
  1. XMIT(DGDFN) ; Queue entry to ^IVM(301.5,#) for HEC HL7 processing
  1.  ;Call API routine to determine the most current MST Status data for
  1.  ; each veteran in the (#29.11) file.
  1.  ;Queue entry for HL7 Z07 message to be sent to the HEC.
  1.  ; Input:
  1.  ;       DGDFN - IEN of PATIENT file (#2)
  1.  ; Output:
  1.  ;        Queue entry to ^IVM(301.5,#) file
  1.  N DGMST               ;MST data from MST HISTORY file (#29.11)
  1.  S DGMST=$$GETSTAT^DGMSTAPI(DGDFN)
  1.  Q:+DGMST<1
  1.  S DGCNT=DGCNT+1
  1.  D SEND^DGMSTL1(DGDFN,"Z07")
  1.  Q
  1.  ;
  1. MSG(DGSTART,DGTCNT,DGCNT,DGMESS) ; Send e-mail to user
  1.  ;Generate a mailman message with total number of patients scanned
  1.  ; and total patients queued for transmission to the HEC.
  1.  ;  Input:
  1.  ;        DGSTART - Job start d/t
  1.  ;        DGTCNT  - Total records scanned
  1.  ;        DGCNT   - Total records queued
  1.  ;        DGMESS  - error message (if any...)
  1.  ;  Output:
  1.  ;         User e-mail message
  1.  ;
  1.  N DIFROM,DGSITE,DGMAIL,DGI
  1.  N XMY,XMDUZ,XMSUB,XMTEXT,XMDUN,XMZ
  1.  S DGSITE=$$SITE^VASITE
  1.  I +DGSITE'>0 S DGSITE="NO SITE#"
  1.  S XMDUZ=.5,(XMY(DUZ),XMY(XMDUZ))=""
  1.  S XMSUB="Patch DG*5.3*379 MST Baseline ("_$P(DGSITE,U,3)_")"
  1.  S XMTEXT="DGMAIL("
  1.  S DGMAIL(1)=""
  1.  S DGMAIL(2)="                 Facility Name: "_$P(DGSITE,U,2)
  1.  S DGMAIL(3)="                Station Number: "_$P(DGSITE,U,3)
  1.  S DGMAIL(4)=""
  1.  S DGMAIL(5)="Date/Time Baseline job started: "_$$FMTE^XLFDT(DGSTART)
  1.  S DGMAIL(6)="Date/Time Baseline job stopped: "_$$HTE^XLFDT($H)
  1.  S DGMAIL(7)=""
  1.  S DGMAIL(8)="Total patient's scanned in MST HISTORY file: "_DGTCNT
  1.  S DGMAIL(9)="Total patient's queued for HEC transmission: "_DGCNT
  1.  S DGMAIL(10)=""
  1.  I $G(DGMESS) D
  1.  .S DGMAIL(11)="             * * *  E R R O R    E N C O U N T E R E D  * * *"
  1.  .S DGMAIL(12)=""
  1.  . F DGI=1:1:DGMESS D
  1.  . . S DGMAIL(12+DGI)="*** "_$E($G(DGMESS(DGI)),1,65)
  1.  ;
  1.  D ^XMD
  1.  Q
  1.  ;
  1. PROGCHK(XPDABORT) ;checks for necessary programmer variables
  1.  ;
  1.  I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") DO
  1.  .D BMES^XPDUTL("*****")
  1.  .D MES^XPDUTL("Your programming variables are not set up properly.")
  1.  .D MES^XPDUTL("Installation aborted.")
  1.  .D MES^XPDUTL("*****")
  1.  .S XPDABORT=2
  1.  Q
  1.  ;
  1. CPRS(XPDABORT) ; Check for the CPRS initial MST Synchronization run date
  1.  ;
  1.  I '+$$GSYINFO^PXRMMST("I") D
  1.  .D BMES^XPDUTL("*****")
  1.  .D MES^XPDUTL("The CPRS initial MST Synchronization has not been run.")
  1.  .D MES^XPDUTL("Installation aborted.")
  1.  .D MES^XPDUTL("*****")
  1.  .S XPDABORT=2  ;Abort all transport globals in distribution but leave
  1.  Q              ; them in ^XTMP().