source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSO7P274.m@ 1042

Last change on this file since 1042 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1PSO7P274 ;SMT - PSO*7*274 Activity Log Cleanup ; 10/11/07 12:16pm
2 ;;7.0;OUTPATIENT PHARMACY;**274**;APR 2007;Build 8
3 ;
4 ;Cleanup routine, to fix erroneous listings of partials in the
5 ;activity log.
6 ;
7 N NAMSP,PATCH,JOBN,DTOUT,DUOUT,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,QUIT,Y,ZTQUEUED,ZTREQ,ZTSAVE
8 S NAMSP=$$NAMSP
9 S JOBN="Activity Log Cleanup"
10 S PATCH="PSO*7*274"
11 ;
12 L +^XTMP(NAMSP):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I '$T D Q
13 . D BMES^XPDUTL(JOBN_" job is already running. Halting...")
14 . D MES^XPDUTL("")
15 . D QUIT
16 ;
17 I '$D(^XTMP(NAMSP)) D INITXTMP(NAMSP,JOBN_", "_PATCH,90) ;90 day life
18 S QUIT=0
19 ;
20 I $G(^XTMP(NAMSP,0,"LAST"))["COMPLETED" D Q
21 . W !!,*7,"This job has been run before to completion on "
22 . W $$FMTE^XLFDT($P($G(^XTMP(NAMSP,0,"LAST")),"^",2)),!!
23 . W "If you want to run it again, the global subscript ^XTMP('"_NAMSP_"') must be",!
24 . W "deleted prior to doing so.",!!
25 . D QUIT
26 ;
27 ;ques 2, if running from mumps prompt
28 I '$D(XPDQUES("POS2")) D I 'ZTDTH D QUIT Q
29 . K DIR
30 . S DIR("A")=" Enter when to Queue the "_JOBN_" job to run in date@time format "
31 . S DIR("B")="NOW"
32 . S DIR(0)="D^::%DT"
33 . 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"
34 . D ^DIR I $D(DUOUT) W !,"Halting..." S ZTDTH="" Q
35 . S:$D(DTOUT) Y=$$NOW^XLFDT S ZTDTH=$$FMTH^XLFDT(Y)
36 ;
37 ;ques 2, if running from kids install
38 I $D(XPDQUES("POS2")) S ZTDTH=$$FMTH^XLFDT(XPDQUES("POS2"))
39 ;
40 D BMES^XPDUTL("=============================================================")
41 D MES^XPDUTL("Queuing background job for "_JOBN_"...")
42 D MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
43 D MES^XPDUTL("==============================================================")
44 I ZTDTH="" D BMES^XPDUTL(JOBN_" NOT QUEUED") D QUIT Q
45 ;
46 S:$D(^XTMP(NAMSP,0,"LAST")) ^XTMP(NAMSP,0,"ZAUDIT",$H)="RE-STARTED ON"_"^"_$$NOW^XLFDT_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
47 ;
48 I $P($G(^XTMP(NAMSP,0,"LAST")),"^")="STOP" D
49 . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="RUN^"_$$NOW^XLFDT
50 E D
51 . S ^XTMP(NAMSP,0,"LAST")="RUN^"_$$NOW^XLFDT_"^^^"
52 ;
53 S ZTRTN="EN^"_NAMSP,ZTIO=""
54 S ZTDESC="Background job for "_JOBN_" on prescriptions updated via "_PATCH
55 S ZTSAVE("JOBN")=""
56 L -^XTMP(NAMSP)
57 D ^%ZTLOAD
58 D:$D(ZTSK)
59 . D MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
60 . D BMES^XPDUTL("")
61 D BMES^XPDUTL("")
62 K XPDQUES
63 Q
64QUIT ;
65 L -^XTMP(NAMSP)
66 Q
67 ;
68STATUS ;show status of job running
69 I $$ST D
70 . W !,"Currently processing:"
71 . I $G(^XTMP($$NAMSP,0,"LAST"))["COMPLETED" D
72 . . W !,"COMPLETED ON ",$$FMTE^XLFDT($P($G(^XTMP($$NAMSP,0,"LAST")),"^",2)),!
73 . W !?5,"Date being processed > ",$$FMTE^XLFDT($P(^XTMP($$NAMSP,0,"LAST"),"^",3))
74 . W !?5," RX # > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",4)
75 . ;W !?5," TOTAL RX's > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",5),!
76 E D
77 .I $G(^XTMP($$NAMSP,0,"LAST"))["COMPLETED" D
78 .. W !,"COMPLETED ON ",$$FMTE^XLFDT($P($G(^XTMP($$NAMSP,0,"LAST")),"^",2)),!
79 Q
80 ;
81STOP ;stop job command
82 I $$ST S ^XTMP($$NAMSP,0,"STOP")="" D
83 . W !,"TALLY MISSING EXPIRATION DATES Job - set to STOP Soon"
84 . W !!,"Check Status to be sure it has stopped and is not running..."
85 . W !," (D STATUS^PSOTEXP1)"
86 Q
87ST() ;status
88 L +^XTMP($$NAMSP):3 I $T D Q 0
89 . L -^XTMP($$NAMSP)
90 . W !,"*** NOT CURRENTLY RUNNING! ***",!
91 Q 1
92INITXTMP(NAMSP,TITLE,LIFE) ;create ^Xtmp according to SAC std
93 N BEGDT,PURGDT
94 S BEGDT=$$NOW^XLFDT()
95 S PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
96 S ^XTMP(NAMSP,0)=PURGDT_"^"_BEGDT_"^"_TITLE
97 Q
98NAMSP() ;
99 Q $T(+0)
100 ;
101EN ;
102 N C,CC,CNT ;Clean erroneous activity log partials
103 S (C,CNT)=0 F S C=$O(^PSRX(C)),CNT=CNT+1 Q:'C I $D(^PSRX(C,"A",0)) D
104 .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
105 Q
Note: See TracBrowser for help on using the repository browser.