PSO613P ;MCF - PSO*7*613 POST-INSTALL ROUTINE TO CLEAN UP CLOZAPINE REGISTRATION DATE. ;12/04/20
;;7.0;OUTPATIENT PHARMACY;**613**;DEC 1997;Build 10
;
; ICRs:
;
Q
;
FGRND ; Run in foreground
N FGRND S FGRND=1
QUE ; Task to background
N NAMSP,PATCH,JOBN,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,Y,ZTQUEUED,ZTREQ,ZTSAVE,SBJM,RESTART
S NAMSP="PSO613P"
S JOBN="PSO*7*613 Post Install"
S PATCH="PSO*7*613"
S Y=$$NOW^XLFDT S ZTDTH=$$FMTH^XLFDT(Y)
;
D BMES^XPDUTL("=============================================================")
D MES^XPDUTL("Queuing background job for "_JOBN_"...")
D MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
D MES^XPDUTL("A MailMan message will be sent to the installer upon Post")
D MES^XPDUTL("Install Completion. This may take 4-5 minutes.")
D MES^XPDUTL("==============================================================")
;
S SBJM="Foreground job for "_JOBN
I $G(FGRND) D EN Q
S (SBJM,ZTDESC)="Background job for "_JOBN
S ZTRTN="EN^"_NAMSP,ZTIO=""
S ZTSAVE("JOBN")="",ZTSAVE("ZTDTH")="",ZTSAVE("DUZ")="",ZTSAVE("SBJM")=""
D ^%ZTLOAD
D:$D(ZTSK)
. D MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
. D BMES^XPDUTL("")
. S ZTSAVE("ZTSK")=""
D BMES^XPDUTL("")
K XPDQUES
Q
EN ; Main entry point to clean up clozapine registration date.
N PSDFN,PSVAL,PSCNT,PSNEW,PSREG,STARTH
S STARTH=$$HTE^XLFDT($S($G(ZTDTH):ZTDTH,1:$H))
D INIT
D REGDATE
D MAIL
Q
REGDATE ; LOOP THROUGH #55 and find bad date time stamps
S PSDFN=0
F S PSDFN=$O(^PS(55,PSDFN)) Q:PSDFN="" D
. S PSVAL=$$GET1^DIQ(55,PSDFN,58,"I")
. I ($G(PSVAL))&(PSVAL[".") D
. . S PSCNT=PSCNT+1
. . W:PSCNT#10 "."
. . S PSNEW=$P(PSVAL,".",1)
. . S PSREG(55,PSDFN_",",58)=PSNEW
. . S ^XTMP("PSO613P",PSNOW,"^PS(55,DFN,SAND)",PSDFN)=PSVAL
D FILE^DIE("","PSREG","PSERR") ; update existing entries
Q
MAIL ;Send message
N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,I
S Y=$$NOW^XLFDT S STOPH=$$FMTH^XLFDT(Y),STOPH=$$HTE^XLFDT(STOPH)
S XMDUZ="PSO*7.0*613 POST INSTALL Complete"
S XMY(DUZ)=""
S ^TMP("PSOTEXT",$J,1)="The background job "_+$G(ZTSK)_" began "_STARTH_" and "
S ^TMP("PSOTEXT",$J,2)="ended "_STOPH_"."
S ^TMP("PSOTEXT",$J,3)="Cleanedup "_PSCNT_" entries."
S XMDUZ="OUTPATIENT PHARMACY",XMSUB=SBJM,XMTEXT="^TMP(""PSOTEXT"","_$J_","
S XMY(DUZ)=""
D ^XMD
K ^TMP("PSOTEXT",$J)
Q
RESTORE ; LOOP THROUGH ^XTMP and RESTORE bad date time stamps
N PSCNT,PSDFN,PSLAST,PSVAL,REG,PSVAL
;K
I '$G(ZTSK) D BMES^XPDUTL("Restoring")
S (PSCNT,PSDFN)=0
S PSLAST=$O(^XTMP("PSO613P",""),-1)
D BMES^XPDUTL("Last restore point was "_PSLAST)
F S PSDFN=$O(^XTMP("PSO613P",PSLAST,"^PS(55,DFN,SAND)",PSDFN)) Q:PSDFN="" S PSVAL=$G(^(PSDFN)) D
. S PSCNT=PSCNT+1
. W:PSCNT#10 "."
. S PSREG(55,PSDFN_",",58)=PSVAL
D FILE^DIE("","PSREG","PSERR") ; update existing entries
I '$G(ZTSK) D BMES^XPDUTL("Restored "_PSCNT_" entries.")
Q
INIT ; Initialize variables DGPREFIX, DGSRVR, DGREGION, and DGKEY
;
S PS90=$$FMADD^XLFDT($$DT^XLFDT,90),PSNOW=$$NOW^XLFDT
S PSDESC="CLOZAPINE - BAD REGISTRATION DATE CLEAN-UP"
S ^XTMP("PSO613P",0)=PS90_"^"_PSNOW_"^"_PSDESC
S PSCNT=0
I '$G(ZTSK) D BMES^XPDUTL(">VARIABLES INITIALIZED")
I '$G(ZTSK) D BMES^XPDUTL("Restore point at "_PSNOW)
Q
REIX5252 ; Reindex new AC Mumps type cross reference in file 52.52
N DIK
S DIK="^PS(52.52,"
S DIK(1)=".01^AC"
D ENALL^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO613P 3412 printed Dec 13, 2024@02:23:21 Page 2
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
+2 ;
+3 ; ICRs:
+4 ;
+5 QUIT
+6 ;
FGRND ; Run in foreground
+1 NEW FGRND
SET FGRND=1
QUE ; Task to background
+1 NEW NAMSP,PATCH,JOBN,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,Y,ZTQUEUED,ZTREQ,ZTSAVE,SBJM,RESTART
+2 SET NAMSP="PSO613P"
+3 SET JOBN="PSO*7*613 Post Install"
+4 SET PATCH="PSO*7*613"
+5 SET Y=$$NOW^XLFDT
SET ZTDTH=$$FMTH^XLFDT(Y)
+6 ;
+7 DO BMES^XPDUTL("=============================================================")
+8 DO MES^XPDUTL("Queuing background job for "_JOBN_"...")
+9 DO MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
+10 DO MES^XPDUTL("A MailMan message will be sent to the installer upon Post")
+11 DO MES^XPDUTL("Install Completion. This may take 4-5 minutes.")
+12 DO MES^XPDUTL("==============================================================")
+13 ;
+14 SET SBJM="Foreground job for "_JOBN
+15 IF $GET(FGRND)
DO EN
QUIT
+16 SET (SBJM,ZTDESC)="Background job for "_JOBN
+17 SET ZTRTN="EN^"_NAMSP
SET ZTIO=""
+18 SET ZTSAVE("JOBN")=""
SET ZTSAVE("ZTDTH")=""
SET ZTSAVE("DUZ")=""
SET ZTSAVE("SBJM")=""
+19 DO ^%ZTLOAD
+20 if $DATA(ZTSK)
Begin DoDot:1
+21 DO MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
+22 DO BMES^XPDUTL("")
+23 SET ZTSAVE("ZTSK")=""
End DoDot:1
+24 DO BMES^XPDUTL("")
+25 KILL XPDQUES
+26 QUIT
EN ; Main entry point to clean up clozapine registration date.
+1 NEW PSDFN,PSVAL,PSCNT,PSNEW,PSREG,STARTH
+2 SET STARTH=$$HTE^XLFDT($SELECT($GET(ZTDTH):ZTDTH,1:$HOROLOG))
+3 DO INIT
+4 DO REGDATE
+5 DO MAIL
+6 QUIT
REGDATE ; LOOP THROUGH #55 and find bad date time stamps
+1 SET PSDFN=0
+2 FOR
SET PSDFN=$ORDER(^PS(55,PSDFN))
if PSDFN=""
QUIT
Begin DoDot:1
+3 SET PSVAL=$$GET1^DIQ(55,PSDFN,58,"I")
+4 IF ($GET(PSVAL))&(PSVAL[".")
Begin DoDot:2
+5 SET PSCNT=PSCNT+1
+6 if PSCNT#10
WRITE "."
+7 SET PSNEW=$PIECE(PSVAL,".",1)
+8 SET PSREG(55,PSDFN_",",58)=PSNEW
+9 SET ^XTMP("PSO613P",PSNOW,"^PS(55,DFN,SAND)",PSDFN)=PSVAL
End DoDot:2
End DoDot:1
+10 ; update existing entries
DO FILE^DIE("","PSREG","PSERR")
+11 QUIT
MAIL ;Send message
+1 NEW DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,I
+2 SET Y=$$NOW^XLFDT
SET STOPH=$$FMTH^XLFDT(Y)
SET STOPH=$$HTE^XLFDT(STOPH)
+3 SET XMDUZ="PSO*7.0*613 POST INSTALL Complete"
+4 SET XMY(DUZ)=""
+5 SET ^TMP("PSOTEXT",$JOB,1)="The background job "_+$GET(ZTSK)_" began "_STARTH_" and "
+6 SET ^TMP("PSOTEXT",$JOB,2)="ended "_STOPH_"."
+7 SET ^TMP("PSOTEXT",$JOB,3)="Cleanedup "_PSCNT_" entries."
+8 SET XMDUZ="OUTPATIENT PHARMACY"
SET XMSUB=SBJM
SET XMTEXT="^TMP(""PSOTEXT"","_$JOB_","
+9 SET XMY(DUZ)=""
+10 DO ^XMD
+11 KILL ^TMP("PSOTEXT",$JOB)
+12 QUIT
RESTORE ; LOOP THROUGH ^XTMP and RESTORE bad date time stamps
+1 NEW PSCNT,PSDFN,PSLAST,PSVAL,REG,PSVAL
+2 ;K
+3 IF '$GET(ZTSK)
DO BMES^XPDUTL("Restoring")
+4 SET (PSCNT,PSDFN)=0
+5 SET PSLAST=$ORDER(^XTMP("PSO613P",""),-1)
+6 DO BMES^XPDUTL("Last restore point was "_PSLAST)
+7 FOR
SET PSDFN=$ORDER(^XTMP("PSO613P",PSLAST,"^PS(55,DFN,SAND)",PSDFN))
if PSDFN=""
QUIT
SET PSVAL=$GET(^(PSDFN))
Begin DoDot:1
+8 SET PSCNT=PSCNT+1
+9 if PSCNT#10
WRITE "."
+10 SET PSREG(55,PSDFN_",",58)=PSVAL
End DoDot:1
+11 ; update existing entries
DO FILE^DIE("","PSREG","PSERR")
+12 IF '$GET(ZTSK)
DO BMES^XPDUTL("Restored "_PSCNT_" entries.")
+13 QUIT
INIT ; Initialize variables DGPREFIX, DGSRVR, DGREGION, and DGKEY
+1 ;
+2 SET PS90=$$FMADD^XLFDT($$DT^XLFDT,90)
SET PSNOW=$$NOW^XLFDT
+3 SET PSDESC="CLOZAPINE - BAD REGISTRATION DATE CLEAN-UP"
+4 SET ^XTMP("PSO613P",0)=PS90_"^"_PSNOW_"^"_PSDESC
+5 SET PSCNT=0
+6 IF '$GET(ZTSK)
DO BMES^XPDUTL(">VARIABLES INITIALIZED")
+7 IF '$GET(ZTSK)
DO BMES^XPDUTL("Restore point at "_PSNOW)
+8 QUIT
REIX5252 ; Reindex new AC Mumps type cross reference in file 52.52
+1 NEW DIK
+2 SET DIK="^PS(52.52,"
+3 SET DIK(1)=".01^AC"
+4 DO ENALL^DIK
+5 QUIT
