PSO7P274 ;SMT - PSO*7*274 Activity Log Cleanup ; 10/11/07 12:16pm
;;7.0;OUTPATIENT PHARMACY;**274**;APR 2007;Build 8
;
;Cleanup routine, to fix erroneous listings of partials in the
;activity log.
;
N NAMSP,PATCH,JOBN,DTOUT,DUOUT,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,QUIT,Y,ZTQUEUED,ZTREQ,ZTSAVE
S NAMSP=$$NAMSP
S JOBN="Activity Log Cleanup"
S PATCH="PSO*7*274"
;
L +^XTMP(NAMSP):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I '$T D Q
. D BMES^XPDUTL(JOBN_" job is already running. Halting...")
. D MES^XPDUTL("")
. D QUIT
;
I '$D(^XTMP(NAMSP)) D INITXTMP(NAMSP,JOBN_", "_PATCH,90) ;90 day life
S QUIT=0
;
I $G(^XTMP(NAMSP,0,"LAST"))["COMPLETED" D Q
. W !!,*7,"This job has been run before to completion on "
. W $$FMTE^XLFDT($P($G(^XTMP(NAMSP,0,"LAST")),"^",2)),!!
. W "If you want to run it again, the global subscript ^XTMP('"_NAMSP_"') must be",!
. W "deleted prior to doing so.",!!
. D QUIT
;
;ques 2, if running from mumps prompt
I '$D(XPDQUES("POS2")) D I 'ZTDTH D QUIT Q
. K DIR
. S DIR("A")=" Enter when to Queue the "_JOBN_" job to run in date@time format "
. S DIR("B")="NOW"
. S DIR(0)="D^::%DT"
. S DIR("?")="Enter when to start the job. The default is Now. You can enter a date and time in the format like this: 021506@3:30p"
. D ^DIR I $D(DUOUT) W !,"Halting..." S ZTDTH="" Q
. S:$D(DTOUT) Y=$$NOW^XLFDT S ZTDTH=$$FMTH^XLFDT(Y)
;
;ques 2, if running from kids install
I $D(XPDQUES("POS2")) S ZTDTH=$$FMTH^XLFDT(XPDQUES("POS2"))
;
D BMES^XPDUTL("=============================================================")
D MES^XPDUTL("Queuing background job for "_JOBN_"...")
D MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
D MES^XPDUTL("==============================================================")
I ZTDTH="" D BMES^XPDUTL(JOBN_" NOT QUEUED") D QUIT Q
;
S:$D(^XTMP(NAMSP,0,"LAST")) ^XTMP(NAMSP,0,"ZAUDIT",$H)="RE-STARTED ON"_"^"_$$NOW^XLFDT_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
;
I $P($G(^XTMP(NAMSP,0,"LAST")),"^")="STOP" D
. S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="RUN^"_$$NOW^XLFDT
E D
. S ^XTMP(NAMSP,0,"LAST")="RUN^"_$$NOW^XLFDT_"^^^"
;
S ZTRTN="EN^"_NAMSP,ZTIO=""
S ZTDESC="Background job for "_JOBN_" on prescriptions updated via "_PATCH
S ZTSAVE("JOBN")=""
L -^XTMP(NAMSP)
D ^%ZTLOAD
D:$D(ZTSK)
. D MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
. D BMES^XPDUTL("")
D BMES^XPDUTL("")
K XPDQUES
Q
QUIT ;
L -^XTMP(NAMSP)
Q
;
STATUS ;show status of job running
I $$ST D
. W !,"Currently processing:"
. I $G(^XTMP($$NAMSP,0,"LAST"))["COMPLETED" D
. . W !,"COMPLETED ON ",$$FMTE^XLFDT($P($G(^XTMP($$NAMSP,0,"LAST")),"^",2)),!
. W !?5,"Date being processed > ",$$FMTE^XLFDT($P(^XTMP($$NAMSP,0,"LAST"),"^",3))
. W !?5," RX # > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",4)
. ;W !?5," TOTAL RX's > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",5),!
E D
.I $G(^XTMP($$NAMSP,0,"LAST"))["COMPLETED" D
.. W !,"COMPLETED ON ",$$FMTE^XLFDT($P($G(^XTMP($$NAMSP,0,"LAST")),"^",2)),!
Q
;
STOP ;stop job command
I $$ST S ^XTMP($$NAMSP,0,"STOP")="" D
. W !,"TALLY MISSING EXPIRATION DATES Job - set to STOP Soon"
. W !!,"Check Status to be sure it has stopped and is not running..."
. W !," (D STATUS^PSOTEXP1)"
Q
ST() ;status
L +^XTMP($$NAMSP):3 I $T D Q 0
. L -^XTMP($$NAMSP)
. W !,"*** NOT CURRENTLY RUNNING! ***",!
Q 1
INITXTMP(NAMSP,TITLE,LIFE) ;create ^Xtmp according to SAC std
N BEGDT,PURGDT
S BEGDT=$$NOW^XLFDT()
S PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
S ^XTMP(NAMSP,0)=PURGDT_"^"_BEGDT_"^"_TITLE
Q
NAMSP() ;
Q $T(+0)
;
EN ;
N C,CC,CNT ;Clean erroneous activity log partials
S (C,CNT)=0 F S C=$O(^PSRX(C)),CNT=CNT+1 Q:'C I $D(^PSRX(C,"A",0)) D
.S CC=0 F S CC=$O(^PSRX(C,"A",CC)) Q:'CC S:($P(^PSRX(C,"A",CC,0),"^",4)=6)&('$D(^PSRX(C,"P",0))) $P(^PSRX(C,"A",CC,0),"^",4)=7
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO7P274 3877 printed Apr 09, 2024@21:32:49 Page 2
PSO7P274 ;SMT - PSO*7*274 Activity Log Cleanup ; 10/11/07 12:16pm
+1 ;;7.0;OUTPATIENT PHARMACY;**274**;APR 2007;Build 8
+2 ;
+3 ;Cleanup routine, to fix erroneous listings of partials in the
+4 ;activity log.
+5 ;
+6 NEW NAMSP,PATCH,JOBN,DTOUT,DUOUT,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,QUIT,Y,ZTQUEUED,ZTREQ,ZTSAVE
+7 SET NAMSP=$$NAMSP
+8 SET JOBN="Activity Log Cleanup"
+9 SET PATCH="PSO*7*274"
+10 ;
+11 LOCK +^XTMP(NAMSP):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF '$TEST
Begin DoDot:1
+12 DO BMES^XPDUTL(JOBN_" job is already running. Halting...")
+13 DO MES^XPDUTL("")
+14 DO QUIT
End DoDot:1
QUIT
+15 ;
+16 ;90 day life
IF '$DATA(^XTMP(NAMSP))
DO INITXTMP(NAMSP,JOBN_", "_PATCH,90)
+17 SET QUIT=0
+18 ;
+19 IF $GET(^XTMP(NAMSP,0,"LAST"))["COMPLETED"
Begin DoDot:1
+20 WRITE !!,*7,"This job has been run before to completion on "
+21 WRITE $$FMTE^XLFDT($PIECE($GET(^XTMP(NAMSP,0,"LAST")),"^",2)),!!
+22 WRITE "If you want to run it again, the global subscript ^XTMP('"_NAMSP_"') must be",!
+23 WRITE "deleted prior to doing so.",!!
+24 DO QUIT
End DoDot:1
QUIT
+25 ;
+26 ;ques 2, if running from mumps prompt
+27 IF '$DATA(XPDQUES("POS2"))
Begin DoDot:1
+28 KILL DIR
+29 SET DIR("A")=" Enter when to Queue the "_JOBN_" job to run in date@time format "
+30 SET DIR("B")="NOW"
+31 SET DIR(0)="D^::%DT"
+32 SET DIR("?")="Enter when to start the job. The default is Now. You can enter a date and time in the format like this: 021506@3:30p"
+33 DO ^DIR
IF $DATA(DUOUT)
WRITE !,"Halting..."
SET ZTDTH=""
QUIT
+34 if $DATA(DTOUT)
SET Y=$$NOW^XLFDT
SET ZTDTH=$$FMTH^XLFDT(Y)
End DoDot:1
IF 'ZTDTH
DO QUIT
QUIT
+35 ;
+36 ;ques 2, if running from kids install
+37 IF $DATA(XPDQUES("POS2"))
SET ZTDTH=$$FMTH^XLFDT(XPDQUES("POS2"))
+38 ;
+39 DO BMES^XPDUTL("=============================================================")
+40 DO MES^XPDUTL("Queuing background job for "_JOBN_"...")
+41 DO MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
+42 DO MES^XPDUTL("==============================================================")
+43 IF ZTDTH=""
DO BMES^XPDUTL(JOBN_" NOT QUEUED")
DO QUIT
QUIT
+44 ;
+45 if $DATA(^XTMP(NAMSP,0,"LAST"))
SET ^XTMP(NAMSP,0,"ZAUDIT",$HOROLOG)="RE-STARTED ON"_"^"_$$NOW^XLFDT_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
+46 ;
+47 IF $PIECE($GET(^XTMP(NAMSP,0,"LAST")),"^")="STOP"
Begin DoDot:1
+48 SET $PIECE(^XTMP(NAMSP,0,"LAST"),"^",1,2)="RUN^"_$$NOW^XLFDT
End DoDot:1
+49 IF '$TEST
Begin DoDot:1
+50 SET ^XTMP(NAMSP,0,"LAST")="RUN^"_$$NOW^XLFDT_"^^^"
End DoDot:1
+51 ;
+52 SET ZTRTN="EN^"_NAMSP
SET ZTIO=""
+53 SET ZTDESC="Background job for "_JOBN_" on prescriptions updated via "_PATCH
+54 SET ZTSAVE("JOBN")=""
+55 LOCK -^XTMP(NAMSP)
+56 DO ^%ZTLOAD
+57 if $DATA(ZTSK)
Begin DoDot:1
+58 DO MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
+59 DO BMES^XPDUTL("")
End DoDot:1
+60 DO BMES^XPDUTL("")
+61 KILL XPDQUES
+62 QUIT
QUIT ;
+1 LOCK -^XTMP(NAMSP)
+2 QUIT
+3 ;
STATUS ;show status of job running
+1 IF $$ST
Begin DoDot:1
+2 WRITE !,"Currently processing:"
+3 IF $GET(^XTMP($$NAMSP,0,"LAST"))["COMPLETED"
Begin DoDot:2
+4 WRITE !,"COMPLETED ON ",$$FMTE^XLFDT($PIECE($GET(^XTMP($$NAMSP,0,"LAST")),"^",2)),!
End DoDot:2
+5 WRITE !?5,"Date being processed > ",$$FMTE^XLFDT($PIECE(^XTMP($$NAMSP,0,"LAST"),"^",3))
+6 WRITE !?5," RX # > ",$PIECE(^XTMP($$NAMSP,0,"LAST"),"^",4)
+7 ;W !?5," TOTAL RX's > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",5),!
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 IF $GET(^XTMP($$NAMSP,0,"LAST"))["COMPLETED"
Begin DoDot:2
+10 WRITE !,"COMPLETED ON ",$$FMTE^XLFDT($PIECE($GET(^XTMP($$NAMSP,0,"LAST")),"^",2)),!
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
STOP ;stop job command
+1 IF $$ST
SET ^XTMP($$NAMSP,0,"STOP")=""
Begin DoDot:1
+2 WRITE !,"TALLY MISSING EXPIRATION DATES Job - set to STOP Soon"
+3 WRITE !!,"Check Status to be sure it has stopped and is not running..."
+4 WRITE !," (D STATUS^PSOTEXP1)"
End DoDot:1
+5 QUIT
ST() ;status
+1 LOCK +^XTMP($$NAMSP):3
IF $TEST
Begin DoDot:1
+2 LOCK -^XTMP($$NAMSP)
+3 WRITE !,"*** NOT CURRENTLY RUNNING! ***",!
End DoDot:1
QUIT 0
+4 QUIT 1
INITXTMP(NAMSP,TITLE,LIFE) ;create ^Xtmp according to SAC std
+1 NEW BEGDT,PURGDT
+2 SET BEGDT=$$NOW^XLFDT()
+3 SET PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
+4 SET ^XTMP(NAMSP,0)=PURGDT_"^"_BEGDT_"^"_TITLE
+5 QUIT
NAMSP() ;
+1 QUIT $TEXT(+0)
+2 ;
EN ;
+1 ;Clean erroneous activity log partials
NEW C,CC,CNT
+2 SET (C,CNT)=0
FOR
SET C=$ORDER(^PSRX(C))
SET CNT=CNT+1
if 'C
QUIT
IF $DATA(^PSRX(C,"A",0))
Begin DoDot:1
+3 SET CC=0
FOR
SET CC=$ORDER(^PSRX(C,"A",CC))
if 'CC
QUIT
if ($PIECE(^PSRX(C,"A",CC,0),"^",4)=6)&('$DATA(^PSRX(C,"P",0)))
SET $PIECE(^PSRX(C,"A",CC,0),"^",4)=7
End DoDot:1
+4 QUIT
