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

PSO613P.m

Go to the documentation of this file.
  1. PSO613P ;MCF - PSO*7*613 POST-INSTALL ROUTINE TO CLEAN UP CLOZAPINE REGISTRATION DATE. ;12/04/20
  1. ;;7.0;OUTPATIENT PHARMACY;**613**;DEC 1997;Build 10
  1. ;
  1. ; ICRs:
  1. ;
  1. Q
  1. ;
  1. FGRND ; Run in foreground
  1. N FGRND S FGRND=1
  1. QUE ; Task to background
  1. N NAMSP,PATCH,JOBN,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,Y,ZTQUEUED,ZTREQ,ZTSAVE,SBJM,RESTART
  1. S NAMSP="PSO613P"
  1. S JOBN="PSO*7*613 Post Install"
  1. S PATCH="PSO*7*613"
  1. S Y=$$NOW^XLFDT S ZTDTH=$$FMTH^XLFDT(Y)
  1. ;
  1. D BMES^XPDUTL("=============================================================")
  1. D MES^XPDUTL("Queuing background job for "_JOBN_"...")
  1. D MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
  1. D MES^XPDUTL("A MailMan message will be sent to the installer upon Post")
  1. D MES^XPDUTL("Install Completion. This may take 4-5 minutes.")
  1. D MES^XPDUTL("==============================================================")
  1. ;
  1. S SBJM="Foreground job for "_JOBN
  1. I $G(FGRND) D EN Q
  1. S (SBJM,ZTDESC)="Background job for "_JOBN
  1. S ZTRTN="EN^"_NAMSP,ZTIO=""
  1. S ZTSAVE("JOBN")="",ZTSAVE("ZTDTH")="",ZTSAVE("DUZ")="",ZTSAVE("SBJM")=""
  1. D ^%ZTLOAD
  1. D:$D(ZTSK)
  1. . D MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
  1. . D BMES^XPDUTL("")
  1. . S ZTSAVE("ZTSK")=""
  1. D BMES^XPDUTL("")
  1. K XPDQUES
  1. Q
  1. EN ; Main entry point to clean up clozapine registration date.
  1. N PSDFN,PSVAL,PSCNT,PSNEW,PSREG,STARTH
  1. S STARTH=$$HTE^XLFDT($S($G(ZTDTH):ZTDTH,1:$H))
  1. D INIT
  1. D REGDATE
  1. D MAIL
  1. Q
  1. REGDATE ; LOOP THROUGH #55 and find bad date time stamps
  1. S PSDFN=0
  1. F S PSDFN=$O(^PS(55,PSDFN)) Q:PSDFN="" D
  1. . S PSVAL=$$GET1^DIQ(55,PSDFN,58,"I")
  1. . I ($G(PSVAL))&(PSVAL[".") D
  1. . . S PSCNT=PSCNT+1
  1. . . W:PSCNT#10 "."
  1. . . S PSNEW=$P(PSVAL,".",1)
  1. . . S PSREG(55,PSDFN_",",58)=PSNEW
  1. . . S ^XTMP("PSO613P",PSNOW,"^PS(55,DFN,SAND)",PSDFN)=PSVAL
  1. D FILE^DIE("","PSREG","PSERR") ; update existing entries
  1. Q
  1. MAIL ;Send message
  1. N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,I
  1. S Y=$$NOW^XLFDT S STOPH=$$FMTH^XLFDT(Y),STOPH=$$HTE^XLFDT(STOPH)
  1. S XMDUZ="PSO*7.0*613 POST INSTALL Complete"
  1. S XMY(DUZ)=""
  1. S ^TMP("PSOTEXT",$J,1)="The background job "_+$G(ZTSK)_" began "_STARTH_" and "
  1. S ^TMP("PSOTEXT",$J,2)="ended "_STOPH_"."
  1. S ^TMP("PSOTEXT",$J,3)="Cleanedup "_PSCNT_" entries."
  1. S XMDUZ="OUTPATIENT PHARMACY",XMSUB=SBJM,XMTEXT="^TMP(""PSOTEXT"","_$J_","
  1. S XMY(DUZ)=""
  1. D ^XMD
  1. K ^TMP("PSOTEXT",$J)
  1. Q
  1. RESTORE ; LOOP THROUGH ^XTMP and RESTORE bad date time stamps
  1. N PSCNT,PSDFN,PSLAST,PSVAL,REG,PSVAL
  1. ;K
  1. I '$G(ZTSK) D BMES^XPDUTL("Restoring")
  1. S (PSCNT,PSDFN)=0
  1. S PSLAST=$O(^XTMP("PSO613P",""),-1)
  1. D BMES^XPDUTL("Last restore point was "_PSLAST)
  1. F S PSDFN=$O(^XTMP("PSO613P",PSLAST,"^PS(55,DFN,SAND)",PSDFN)) Q:PSDFN="" S PSVAL=$G(^(PSDFN)) D
  1. . S PSCNT=PSCNT+1
  1. . W:PSCNT#10 "."
  1. . S PSREG(55,PSDFN_",",58)=PSVAL
  1. D FILE^DIE("","PSREG","PSERR") ; update existing entries
  1. I '$G(ZTSK) D BMES^XPDUTL("Restored "_PSCNT_" entries.")
  1. Q
  1. INIT ; Initialize variables DGPREFIX, DGSRVR, DGREGION, and DGKEY
  1. ;
  1. S PS90=$$FMADD^XLFDT($$DT^XLFDT,90),PSNOW=$$NOW^XLFDT
  1. S PSDESC="CLOZAPINE - BAD REGISTRATION DATE CLEAN-UP"
  1. S ^XTMP("PSO613P",0)=PS90_"^"_PSNOW_"^"_PSDESC
  1. S PSCNT=0
  1. I '$G(ZTSK) D BMES^XPDUTL(">VARIABLES INITIALIZED")
  1. I '$G(ZTSK) D BMES^XPDUTL("Restore point at "_PSNOW)
  1. Q
  1. REIX5252 ; Reindex new AC Mumps type cross reference in file 52.52
  1. N DIK
  1. S DIK="^PS(52.52,"
  1. S DIK(1)=".01^AC"
  1. D ENALL^DIK
  1. Q