- 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 Feb 18, 2025@23:49:40 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