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

XT73P129.m

Go to the documentation of this file. 
  1. XT73P129 ;OAK/MKO-POST-INSTALL ROUTINE FOR XT*7.3*129 ;25 Jan 2011  10:17 PM
  1.  ;;7.3;TOOLKIT;**129**;Apr 25, 1995;Build 2
  1.  Q
  1.  ;
  1. EN ; **129,MPIC_2382
  1.  ; This entry point is called from the POST-INSTALL of patch XT*7.3*129.
  1.  ; It queues a process to purge File #15 of entries that meet the following criteria:
  1.  ;   - STATUS (Field #.03) = 'P' for POTENTIAL DUPLICATE, UNVERIFIED
  1.  ;   - MERGE STATUS (Field #.05) = 0 or ""
  1.  ;   - WHO CREATED (field #.09) = POSTMASTER (.5)
  1.  D MSG
  1.  D QUEUE Q:$G(XPDABORT)
  1.  Q
  1.  ;
  1. PURGE ; Purge records. This is the entry point for the queued task.
  1.  N PAIR,DA,DIK,X,Y,MSG,XTMPNAME
  1.  ;
  1.  ; Set the header nodes in ^XTMP
  1.  S XTMPNAME=$$SETXTMP
  1.  ;
  1.  ; Loop through records in the "APOT" index for records pertaining to
  1.  ; the Patient file and call ^DIK
  1.  S DIK="^VA(15,"
  1.  S PAIR="" F  S PAIR=$O(^VA(15,"APOT","DPT(",PAIR)) Q:PAIR=""  D
  1.  . S DA=0 F  S DA=$O(^VA(15,"APOT","DPT(",PAIR,DA)) Q:'DA  D
  1.  .. ; Screen on WHO CREATED = .5 (POSTMASTER) AND MERGE STATUS = 0 OR ""
  1.  .. I $D(^VA(15,DA,0))#2,$P(^(0),U,9)=.5,'$P(^(0),U,5) D
  1.  ... ; Record status info in ^XTMP, save 0 node of record
  1.  ... ; and write to console if not queued
  1.  ... N STR
  1.  ... S STR="IEN="_DA_", DFN pair="_PAIR
  1.  ... S @XTMPNAME@(0,"STATUS")="Deleting "_STR
  1.  ... S @XTMPNAME@(DA,0)=$G(^VA(15,DA,0))
  1.  ... W:'$D(ZTQUEUED) !,"Deleting "_STR
  1.  ... ;
  1.  ... ; Delete the record and update count and status
  1.  ... D ^DIK
  1.  ... S @XTMPNAME@(0,"CNT")=$G(@XTMPNAME@(0,"CNT"))+1
  1.  ... S @XTMPNAME@(0,"STATUS")="Deleted "_STR
  1.  ;
  1.  ; Record results in ^XTMP
  1.  S @XTMPNAME@(0,"STATUS")="Completed successfully."
  1.  S @XTMPNAME@(0,"COMPLETED")=$$NOW^XLFDT
  1.  ;
  1.  ; Delete task and send MailMan message if queued.
  1.  ; Write a message if not queued.
  1.  I $D(ZTQUEUED) D
  1.  . S ZTREQ="@"
  1.  . D EMAIL(XTMPNAME)
  1.  E  D
  1.  . W !!,"Process completed successfully, "_@XTMPNAME@(0,"CNT")_" records deleted.",!
  1.  Q
  1.  ;
  1. SETXTMP() ; Set up nodes in ^XTMP("XT73P129")
  1.  ; Return the string ^XTMP("XT73P129",fmStartTime)
  1.  N TSTAMP,XTMPNAME
  1.  S TSTAMP=$$NOW^XLFDT
  1.  S ^XTMP("XT73P129",0)=$$FMADD^XLFDT($$DT^XLFDT,60)_U_TSTAMP_U_"Purge of DUPLICATE RECORD File (#15) of POTENTIAL DUPLICATE, UNVERIFIED patient records created by the POSTMASTER (#.5)"
  1.  S XTMPNAME=$NA(^XTMP("XT73P129",TSTAMP))
  1.  S @XTMPNAME@(0,"CNT")=0
  1.  S @XTMPNAME@(0,"DUZ")=$S($G(XTQUEDUZ)>0:XTQUEDUZ,$G(DUZ)>0:DUZ,1:.5)
  1.  S @XTMPNAME@(0,"STATUS")="Process started."
  1.  S @XTMPNAME@(0,"STARTED")=TSTAMP
  1.  Q XTMPNAME
  1.  ;
  1. QUEUE ; Queue the purging process
  1.  N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,XTQUEDUZ
  1.  S ZTRTN="PURGE^XT73P129"
  1.  S ZTDESC="Purge 'Potential Duplicate, Unverified' patient records from DUPLICATE RECORD File (#15)."
  1.  S ZTDTH=$H
  1.  S ZTIO=""
  1.  S XTQUEDUZ=$S($G(DUZ)>0:DUZ,1:.5),ZTSAVE("XTQUEDUZ")=""
  1.  D ^%ZTLOAD
  1.  I $D(ZTSK)[0 D
  1.  . D BMES^XPDUTL("*** Failed to queue the purging process. Post installation aborted. ***")
  1.  . S:$G(XPDNM)]"" XPDABORT=1
  1.  E  D
  1.  . D BMES^XPDUTL("Purging process queued. Task: "_ZTSK)
  1.  Q
  1.  ;
  1. MSG ; Display/log introductory message
  1.  N MSG
  1.  D ADD(.MSG,"Queuing a TaskMan task to purge records from the DUPLICATE RECORD File (#15)")
  1.  D ADD(.MSG,"that meet the following criteria:")
  1.  D ADD(.MSG,"")
  1.  D ADD(.MSG,"  - STATUS (Field #.03) = 'P' for POTENTIAL DUPLICATE, UNVERIFIED")
  1.  D ADD(.MSG,"  - MERGE STATUS (Field #.05) = 0 or """"")
  1.  D ADD(.MSG,"  - WHO CREATED (field #.09) = POSTMASTER (.5)")
  1.  D ADD(.MSG,"")
  1.  D ADD(.MSG,"The tasked process stores information in the ^XTMP(""XT73P129"") global.")
  1.  D ADD(.MSG,"")
  1.  D ADD(.MSG,"  ^XTMP(""XT73P129"",fmStartTime,IEN,0)         : 0 node of the record deleted")
  1.  D ADD(.MSG,"  ^XTMP(""XT73P129"",fmStartTime,0,""CNT"")       : No. of records deleted")
  1.  D ADD(.MSG,"  ^XTMP(""XT73P129"",fmStartTime,0,""COMPLETED"") : Completion time in FM format")
  1.  D ADD(.MSG,"  ^XTMP(""XT73P129"",fmStartTime,0,""DUZ"")       : DUZ of user")
  1.  D ADD(.MSG,"  ^XTMP(""XT73P129"",fmStartTime,0,""STARTED"")   : Start time in FM format")
  1.  D ADD(.MSG,"  ^XTMP(""XT73P129"",fmStartTime,0,""STATUS"")    : Status information")
  1.  D MES^XPDUTL(.MSG)
  1.  Q
  1.  ;
  1. EMAIL(XTMPNAME) ; Send e-mail with summary information
  1.  N XTQUEDUZ,STATUS,CNT,COMPLETE,START,XMDUZ,XMSUB,XMY,XMTEXT,XMMG,XTTEXT,DIFROM
  1.  ;
  1.  ; Get information from ^XTMP
  1.  S XTQUEDUZ=$G(@XTMPNAME@(0,"DUZ"))
  1.  S STATUS=$G(@XTMPNAME@(0,"STATUS"))
  1.  S CNT=+$G(@XTMPNAME@(0,"CNT"))
  1.  S START=$G(@XTMPNAME@(0,"STARTED"))
  1.  S COMPLETE=$G(@XTMPNAME@(0,"COMPLETED"))
  1.  ;
  1.  ; Build and send an e-mail message to POSTMASTER and user who queued
  1.  ; the process
  1.  S XMDUZ=.5
  1.  S XMSUB="XT*7.3*129 POST-INSTALL COMPLETE"
  1.  S XMY(XTQUEDUZ)=""
  1.  S XMY(.5)=""
  1.  S XMTEXT="XTTEXT("
  1.  D ADD(.XTTEXT,"Post Install for patch XT*7.3*129 has run to completion.")
  1.  D ADD(.XTTEXT,"")
  1.  D ADD(.XTTEXT,"       Time started: "_$$FMTE^XLFDT(START))
  1.  D ADD(.XTTEXT,"     Time completed: "_$$FMTE^XLFDT(COMPLETE))
  1.  D ADD(.XTTEXT,"")
  1.  D ADD(.XTTEXT,CNT_" records were deleted from the DUPLICATE RECORD File (#15).")
  1.  D ADD(.XTTEXT,"")
  1.  D ADD(.XTTEXT,"The 0 nodes of deleted records are backed up in:")
  1.  D ADD(.XTTEXT,"")
  1.  D ADD(.XTTEXT,"  ^XTMP(""XT73P129"","_START_",IEN,0)")
  1.  D ADD(.XTTEXT,"")
  1.  D ADD(.XTTEXT,"You may now delete routine XT73P129.")
  1.  D ^XMD
  1.  Q
  1.  ;
  1. ADD(ARRAY,TXT) ; Add text to an array (passed by reference)
  1.  S ARRAY($O(ARRAY(""),-1)+1)=TXT
  1.  Q