XT73P129 ;OAK/MKO-POST-INSTALL ROUTINE FOR XT*7.3*129 ;25 Jan 2011 10:17 PM
;;7.3;TOOLKIT;**129**;Apr 25, 1995;Build 1
Q
;
EN ; **129,MPIC_2382
; This entry point is called from the POST-INSTALL of patch XT*7.3*129.
; It queues a process to purge File #15 of entries that meet the following criteria:
; - STATUS (Field #.03) = 'P' for POTENTIAL DUPLICATE, UNVERIFIED
; - MERGE STATUS (Field #.05) = 0 or ""
; - WHO CREATED (field #.09) = POSTMASTER (.5)
D MSG
D QUEUE Q:$G(XPDABORT)
Q
;
PURGE ; Purge records. This is the entry point for the queued task.
N PAIR,DA,DIK,X,Y,MSG,XTMPNAME
;
; Set the header nodes in ^XTMP
S XTMPNAME=$$SETXTMP
;
; Loop through records in the "APOT" index for records pertaining to
; the Patient file and call ^DIK
S DIK="^VA(15,"
S PAIR="" F S PAIR=$O(^VA(15,"APOT","DPT(",PAIR)) Q:PAIR="" D
. S DA=0 F S DA=$O(^VA(15,"APOT","DPT(",PAIR,DA)) Q:'DA D
.. ; Screen on WHO CREATED = .5 (POSTMASTER) AND MERGE STATUS = 0 OR ""
.. I $D(^VA(15,DA,0))#2,$P(^(0),U,9)=.5,'$P(^(0),U,5) D
... ; Record status info in ^XTMP, save 0 node of record
... ; and write to console if not queued
... N STR
... S STR="IEN="_DA_", DFN pair="_PAIR
... S @XTMPNAME@(0,"STATUS")="Deleting "_STR
... S @XTMPNAME@(DA,0)=$G(^VA(15,DA,0))
... W:'$D(ZTQUEUED) !,"Deleting "_STR
... ;
... ; Delete the record and update count and status
... D ^DIK
... S @XTMPNAME@(0,"CNT")=$G(@XTMPNAME@(0,"CNT"))+1
... S @XTMPNAME@(0,"STATUS")="Deleted "_STR
;
; Record results in ^XTMP
S @XTMPNAME@(0,"STATUS")="Completed successfully."
S @XTMPNAME@(0,"COMPLETED")=$$NOW^XLFDT
;
; Delete task and send MailMan message if queued.
; Write a message if not queued.
I $D(ZTQUEUED) D
. S ZTREQ="@"
. D EMAIL(XTMPNAME)
E D
. W !!,"Process completed successfully, "_@XTMPNAME@(0,"CNT")_" records deleted.",!
Q
;
SETXTMP() ; Set up nodes in ^XTMP("XT73P129")
; Return the string ^XTMP("XT73P129",fmStartTime)
N TSTAMP,XTMPNAME
S TSTAMP=$$NOW^XLFDT
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)"
S XTMPNAME=$NA(^XTMP("XT73P129",TSTAMP))
S @XTMPNAME@(0,"CNT")=0
S @XTMPNAME@(0,"DUZ")=$S($G(XTQUEDUZ)>0:XTQUEDUZ,$G(DUZ)>0:DUZ,1:.5)
S @XTMPNAME@(0,"STATUS")="Process started."
S @XTMPNAME@(0,"STARTED")=TSTAMP
Q XTMPNAME
;
QUEUE ; Queue the purging process
N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,XTQUEDUZ
S ZTRTN="PURGE^XT73P129"
S ZTDESC="Purge 'Potential Duplicate, Unverified' patient records from DUPLICATE RECORD File (#15)."
S ZTDTH=$H
S ZTIO=""
S XTQUEDUZ=$S($G(DUZ)>0:DUZ,1:.5),ZTSAVE("XTQUEDUZ")=""
D ^%ZTLOAD
I $D(ZTSK)[0 D
. D BMES^XPDUTL("*** Failed to queue the purging process. Post installation aborted. ***")
. S:$G(XPDNM)]"" XPDABORT=1
E D
. D BMES^XPDUTL("Purging process queued. Task: "_ZTSK)
Q
;
MSG ; Display/log introductory message
N MSG
D ADD(.MSG,"Queuing a TaskMan task to purge records from the DUPLICATE RECORD File (#15)")
D ADD(.MSG,"that meet the following criteria:")
D ADD(.MSG,"")
D ADD(.MSG," - STATUS (Field #.03) = 'P' for POTENTIAL DUPLICATE, UNVERIFIED")
D ADD(.MSG," - MERGE STATUS (Field #.05) = 0 or """"")
D ADD(.MSG," - WHO CREATED (field #.09) = POSTMASTER (.5)")
D ADD(.MSG,"")
D ADD(.MSG,"The tasked process stores information in the ^XTMP(""XT73P129"") global.")
D ADD(.MSG,"")
D ADD(.MSG," ^XTMP(""XT73P129"",fmStartTime,IEN,0) : 0 node of the record deleted")
D ADD(.MSG," ^XTMP(""XT73P129"",fmStartTime,0,""CNT"") : No. of records deleted")
D ADD(.MSG," ^XTMP(""XT73P129"",fmStartTime,0,""COMPLETED"") : Completion time in FM format")
D ADD(.MSG," ^XTMP(""XT73P129"",fmStartTime,0,""DUZ"") : DUZ of user")
D ADD(.MSG," ^XTMP(""XT73P129"",fmStartTime,0,""STARTED"") : Start time in FM format")
D ADD(.MSG," ^XTMP(""XT73P129"",fmStartTime,0,""STATUS"") : Status information")
D MES^XPDUTL(.MSG)
Q
;
EMAIL(XTMPNAME) ; Send e-mail with summary information
N XTQUEDUZ,STATUS,CNT,COMPLETE,START,XMDUZ,XMSUB,XMY,XMTEXT,XMMG,XTTEXT,DIFROM
;
; Get information from ^XTMP
S XTQUEDUZ=$G(@XTMPNAME@(0,"DUZ"))
S STATUS=$G(@XTMPNAME@(0,"STATUS"))
S CNT=+$G(@XTMPNAME@(0,"CNT"))
S START=$G(@XTMPNAME@(0,"STARTED"))
S COMPLETE=$G(@XTMPNAME@(0,"COMPLETED"))
;
; Build and send an e-mail message to POSTMASTER and user who queued
; the process
S XMDUZ=.5
S XMSUB="XT*7.3*129 POST-INSTALL COMPLETE"
S XMY(XTQUEDUZ)=""
S XMY(.5)=""
S XMTEXT="XTTEXT("
D ADD(.XTTEXT,"Post Install for patch XT*7.3*129 has run to completion.")
D ADD(.XTTEXT,"")
D ADD(.XTTEXT," Time started: "_$$FMTE^XLFDT(START))
D ADD(.XTTEXT," Time completed: "_$$FMTE^XLFDT(COMPLETE))
D ADD(.XTTEXT,"")
D ADD(.XTTEXT,CNT_" records were deleted from the DUPLICATE RECORD File (#15).")
D ADD(.XTTEXT,"")
D ADD(.XTTEXT,"The 0 nodes of deleted records are backed up in:")
D ADD(.XTTEXT,"")
D ADD(.XTTEXT," ^XTMP(""XT73P129"","_START_",IEN,0)")
D ADD(.XTTEXT,"")
D ADD(.XTTEXT,"You may now delete routine XT73P129.")
D ^XMD
Q
;
ADD(ARRAY,TXT) ; Add text to an array (passed by reference)
S ARRAY($O(ARRAY(""),-1)+1)=TXT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXT73P129 5340 printed Apr 09, 2024@21:44:35 Page 2
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 1
+2 QUIT
+3 ;
EN ; **129,MPIC_2382
+1 ; This entry point is called from the POST-INSTALL of patch XT*7.3*129.
+2 ; It queues a process to purge File #15 of entries that meet the following criteria:
+3 ; - STATUS (Field #.03) = 'P' for POTENTIAL DUPLICATE, UNVERIFIED
+4 ; - MERGE STATUS (Field #.05) = 0 or ""
+5 ; - WHO CREATED (field #.09) = POSTMASTER (.5)
+6 DO MSG
+7 DO QUEUE
if $GET(XPDABORT)
QUIT
+8 QUIT
+9 ;
PURGE ; Purge records. This is the entry point for the queued task.
+1 NEW PAIR,DA,DIK,X,Y,MSG,XTMPNAME
+2 ;
+3 ; Set the header nodes in ^XTMP
+4 SET XTMPNAME=$$SETXTMP
+5 ;
+6 ; Loop through records in the "APOT" index for records pertaining to
+7 ; the Patient file and call ^DIK
+8 SET DIK="^VA(15,"
+9 SET PAIR=""
FOR
SET PAIR=$ORDER(^VA(15,"APOT","DPT(",PAIR))
if PAIR=""
QUIT
Begin DoDot:1
+10 SET DA=0
FOR
SET DA=$ORDER(^VA(15,"APOT","DPT(",PAIR,DA))
if 'DA
QUIT
Begin DoDot:2
+11 ; Screen on WHO CREATED = .5 (POSTMASTER) AND MERGE STATUS = 0 OR ""
+12 IF $DATA(^VA(15,DA,0))#2
IF $PIECE(^(0),U,9)=.5
IF '$PIECE(^(0),U,5)
Begin DoDot:3
+13 ; Record status info in ^XTMP, save 0 node of record
+14 ; and write to console if not queued
+15 NEW STR
+16 SET STR="IEN="_DA_", DFN pair="_PAIR
+17 SET @XTMPNAME@(0,"STATUS")="Deleting "_STR
+18 SET @XTMPNAME@(DA,0)=$GET(^VA(15,DA,0))
+19 if '$DATA(ZTQUEUED)
WRITE !,"Deleting "_STR
+20 ;
+21 ; Delete the record and update count and status
+22 DO ^DIK
+23 SET @XTMPNAME@(0,"CNT")=$GET(@XTMPNAME@(0,"CNT"))+1
+24 SET @XTMPNAME@(0,"STATUS")="Deleted "_STR
End DoDot:3
End DoDot:2
End DoDot:1
+25 ;
+26 ; Record results in ^XTMP
+27 SET @XTMPNAME@(0,"STATUS")="Completed successfully."
+28 SET @XTMPNAME@(0,"COMPLETED")=$$NOW^XLFDT
+29 ;
+30 ; Delete task and send MailMan message if queued.
+31 ; Write a message if not queued.
+32 IF $DATA(ZTQUEUED)
Begin DoDot:1
+33 SET ZTREQ="@"
+34 DO EMAIL(XTMPNAME)
End DoDot:1
+35 IF '$TEST
Begin DoDot:1
+36 WRITE !!,"Process completed successfully, "_@XTMPNAME@(0,"CNT")_" records deleted.",!
End DoDot:1
+37 QUIT
+38 ;
SETXTMP() ; Set up nodes in ^XTMP("XT73P129")
+1 ; Return the string ^XTMP("XT73P129",fmStartTime)
+2 NEW TSTAMP,XTMPNAME
+3 SET TSTAMP=$$NOW^XLFDT
+4 SET ^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)"
+5 SET XTMPNAME=$NAME(^XTMP("XT73P129",TSTAMP))
+6 SET @XTMPNAME@(0,"CNT")=0
+7 SET @XTMPNAME@(0,"DUZ")=$SELECT($GET(XTQUEDUZ)>0:XTQUEDUZ,$GET(DUZ)>0:DUZ,1:.5)
+8 SET @XTMPNAME@(0,"STATUS")="Process started."
+9 SET @XTMPNAME@(0,"STARTED")=TSTAMP
+10 QUIT XTMPNAME
+11 ;
QUEUE ; Queue the purging process
+1 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,XTQUEDUZ
+2 SET ZTRTN="PURGE^XT73P129"
+3 SET ZTDESC="Purge 'Potential Duplicate, Unverified' patient records from DUPLICATE RECORD File (#15)."
+4 SET ZTDTH=$HOROLOG
+5 SET ZTIO=""
+6 SET XTQUEDUZ=$SELECT($GET(DUZ)>0:DUZ,1:.5)
SET ZTSAVE("XTQUEDUZ")=""
+7 DO ^%ZTLOAD
+8 IF $DATA(ZTSK)[0
Begin DoDot:1
+9 DO BMES^XPDUTL("*** Failed to queue the purging process. Post installation aborted. ***")
+10 if $GET(XPDNM)]""
SET XPDABORT=1
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 DO BMES^XPDUTL("Purging process queued. Task: "_ZTSK)
End DoDot:1
+13 QUIT
+14 ;
MSG ; Display/log introductory message
+1 NEW MSG
+2 DO ADD(.MSG,"Queuing a TaskMan task to purge records from the DUPLICATE RECORD File (#15)")
+3 DO ADD(.MSG,"that meet the following criteria:")
+4 DO ADD(.MSG,"")
+5 DO ADD(.MSG," - STATUS (Field #.03) = 'P' for POTENTIAL DUPLICATE, UNVERIFIED")
+6 DO ADD(.MSG," - MERGE STATUS (Field #.05) = 0 or """"")
+7 DO ADD(.MSG," - WHO CREATED (field #.09) = POSTMASTER (.5)")
+8 DO ADD(.MSG,"")
+9 DO ADD(.MSG,"The tasked process stores information in the ^XTMP(""XT73P129"") global.")
+10 DO ADD(.MSG,"")
+11 DO ADD(.MSG," ^XTMP(""XT73P129"",fmStartTime,IEN,0) : 0 node of the record deleted")
+12 DO ADD(.MSG," ^XTMP(""XT73P129"",fmStartTime,0,""CNT"") : No. of records deleted")
+13 DO ADD(.MSG," ^XTMP(""XT73P129"",fmStartTime,0,""COMPLETED"") : Completion time in FM format")
+14 DO ADD(.MSG," ^XTMP(""XT73P129"",fmStartTime,0,""DUZ"") : DUZ of user")
+15 DO ADD(.MSG," ^XTMP(""XT73P129"",fmStartTime,0,""STARTED"") : Start time in FM format")
+16 DO ADD(.MSG," ^XTMP(""XT73P129"",fmStartTime,0,""STATUS"") : Status information")
+17 DO MES^XPDUTL(.MSG)
+18 QUIT
+19 ;
EMAIL(XTMPNAME) ; Send e-mail with summary information
+1 NEW XTQUEDUZ,STATUS,CNT,COMPLETE,START,XMDUZ,XMSUB,XMY,XMTEXT,XMMG,XTTEXT,DIFROM
+2 ;
+3 ; Get information from ^XTMP
+4 SET XTQUEDUZ=$GET(@XTMPNAME@(0,"DUZ"))
+5 SET STATUS=$GET(@XTMPNAME@(0,"STATUS"))
+6 SET CNT=+$GET(@XTMPNAME@(0,"CNT"))
+7 SET START=$GET(@XTMPNAME@(0,"STARTED"))
+8 SET COMPLETE=$GET(@XTMPNAME@(0,"COMPLETED"))
+9 ;
+10 ; Build and send an e-mail message to POSTMASTER and user who queued
+11 ; the process
+12 SET XMDUZ=.5
+13 SET XMSUB="XT*7.3*129 POST-INSTALL COMPLETE"
+14 SET XMY(XTQUEDUZ)=""
+15 SET XMY(.5)=""
+16 SET XMTEXT="XTTEXT("
+17 DO ADD(.XTTEXT,"Post Install for patch XT*7.3*129 has run to completion.")
+18 DO ADD(.XTTEXT,"")
+19 DO ADD(.XTTEXT," Time started: "_$$FMTE^XLFDT(START))
+20 DO ADD(.XTTEXT," Time completed: "_$$FMTE^XLFDT(COMPLETE))
+21 DO ADD(.XTTEXT,"")
+22 DO ADD(.XTTEXT,CNT_" records were deleted from the DUPLICATE RECORD File (#15).")
+23 DO ADD(.XTTEXT,"")
+24 DO ADD(.XTTEXT,"The 0 nodes of deleted records are backed up in:")
+25 DO ADD(.XTTEXT,"")
+26 DO ADD(.XTTEXT," ^XTMP(""XT73P129"","_START_",IEN,0)")
+27 DO ADD(.XTTEXT,"")
+28 DO ADD(.XTTEXT,"You may now delete routine XT73P129.")
+29 DO ^XMD
+30 QUIT
+31 ;
ADD(ARRAY,TXT) ; Add text to an array (passed by reference)
+1 SET ARRAY($ORDER(ARRAY(""),-1)+1)=TXT
+2 QUIT
