source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOCIDC7.m@ 1489

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

initial load of WorldVistAEHR

File size: 6.3 KB
Line 
1PSOCIDC7 ;BIR/LE-CIDC Activity logs correction ;2/28/05 12:50pm
2 ;;7.0;OUTPATIENT PHARMACY;**239**;DEC 1997
3 ;
4 N NAMSP,DTOUT,DUOUT,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,QUIT,RUNOPT,JOBN,Y
5 S NAMSP=$$NAMSP
6 S JOBN="CIDC ACTIVITY LOGS CORRECTION"
7 ;
8 L +^XTMP(NAMSP):0 I '$T D Q
9 . D BMES^XPDUTL(JOBN_" job is already running. Halting...")
10 . D MES^XPDUTL("")
11 . D QUIT
12 ;
13 I '$D(^XTMP(NAMSP)) D INITXTMP(NAMSP,"Correct CIDC created activity logs, PSO*7*239",90) ;90 day life
14 S QUIT=0
15 ;
16 ;ques 1, if running from mumps prompt
17 I '$D(XPDQUES("POS1")) D I QUIT D QUIT Q
18 . ;selected cancel run at last install, dont allow to run manually
19 . I $G(^XTMP(NAMSP,0,"LAST"))["CANCEL" D Q
20 . . S QUIT=1
21 . . W !!,*7,"The last install of this patch you selected to NOT Run the Activity Logs Correction process."
22 . . W !,"If you have changed your mind, you must re-install the patch to run",!!
23 . K DIR
24 . S DIR("A",1)="****************** SELECT RUN OPTION ******************"
25 . S DIR("A")="Do you want to run the activity logs correction process? Y or N// "
26 . S DIR(0)="YA^^"
27 . D ^DIR I $D(DTOUT)!($D(DUOUT)) W !,"Halting..." S QUIT=1 Q
28 . S RUNOPT=Y
29 . S:'RUNOPT QUIT=1
30 ;
31 ;ques 1, if running from kids install
32 I $D(XPDQUES("POS1")) D I 'RUNOPT D QUIT Q
33 . S RUNOPT=XPDQUES("POS1")
34 . S:'RUNOPT ^XTMP(NAMSP,0,"LAST")="CANCEL RUN^"_$$NOW^XLFDT_"^^^"
35 . D BMES^XPDUTL("***** SELECTED "_$S('RUNOPT:"NOT ",1:"")_"TO RUN THE ACTIVITY LOGS CORRECTION PROCESS *****")
36 ;
37 I $G(^XTMP(NAMSP,0,"LAST"))["COMPLETED" D Q
38 . W !!,*7,"This job has been run before to completion on "
39 . W $$FMTE^XLFDT($P($G(^XTMP(NAMSP,0,"LAST")),"^",2)),!!
40 . D QUIT
41 ;
42 ;ques 2, if running from mumps prompt
43 I '$D(XPDQUES("POS2")) D I 'ZTDTH D QUIT Q
44 . K DIR
45 . S DIR("A")=" Enter when to Queue the "_JOBN_" job to run in date@time format "
46 . S DIR("B")="NOW"
47 . S DIR(0)="D^::%DT"
48 . 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"
49 . D ^DIR I $D(DUOUT) W !,"Halting..." S ZTDTH="" Q
50 . S:$D(DTOUT) Y=$$NOW^XLFDT S ZTDTH=$$FMTH^XLFDT(Y)
51 ;
52 ;ques 2, if running from kids install
53 I $D(XPDQUES("POS2")) S ZTDTH=$$FMTH^XLFDT(XPDQUES("POS2"))
54 ;
55 D BMES^XPDUTL("===================================================")
56 D MES^XPDUTL("Queuing background job for "_JOBN_"...")
57 D MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
58 D MES^XPDUTL("===================================================")
59 I ZTDTH="" D BMES^XPDUTL(JOBN_" NOT QUEUED") D QUIT Q
60 ;
61 S:$D(^XTMP(NAMSP,0,"LAST")) ^XTMP(NAMSP,0,"ZAUDIT",$H)="RE-STARTED ON"_"^"_$$NOW^XLFDT_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
62 ;
63 I $P($G(^XTMP(NAMSP,0,"LAST")),"^")="STOP" D
64 . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="RUN^"_$$NOW^XLFDT
65 E D
66 . S ^XTMP(NAMSP,0,"LAST")="RUN^"_$$NOW^XLFDT_"^^^"
67 ;
68 S ZTRTN="EN^PSOCIDC7",ZTIO=""
69 S ZTDESC="Background job for "_JOBN_" on prescriptions updated via PSO*7*239"
70 S ZTSAVE("JOBN")=""
71 L -^XTMP(NAMSP)
72 D ^%ZTLOAD
73 D:$D(ZTSK)
74 . D MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
75 . D BMES^XPDUTL("")
76 D BMES^XPDUTL("")
77 K XPDQUES
78 Q
79QUIT ;
80 L -^XTMP(NAMSP)
81 Q
82EN ;
83 N NAMSP S NAMSP=$$NAMSP
84 ;if can't get Lock, then already running.
85 L +^XTMP(NAMSP):3 I '$T D Q
86 . S:$D(ZTQUEUED) ZTREQ="@"
87 . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="LOCKED^"_$$NOW^XLFDT
88 ;
89 N DFN,PSODT,RXP,PSOTEXT,XX,YY,PSOCNT,PSOUCNT,PSOCCNT,PSOSTART,PSOEND,PSOVETS,PSOCVETS,PSOUVETS,PSOTRX,XIEN
90 N PSOSCMX,PSODFN,PSOUDFN,PSOREL,PSOAMT,PSOCAMT,PSOUAMT,FOUND,PSOTRF,PSOEND2,PSOSTRT2,CC
91 N PSOTIME,PSOSTNM,PSOS1,PSOINST,I,PSOTC,PSOCNTS,PSOUCNTS,PSOCCNTS,LIN,%,X1,XMY,STO,PSOSCP
92 D NOW^%DTC S (Y,PSOS1)=% D DD^%DT S PSOSTART=Y
93 S PSOSTRT2=$$FMTE^XLFDT(%,"1PS")
94 I '$G(DT) S DT=$$DT^XLFDT
95 S PSODT=+$P($G(^XTMP(NAMSP,0,"LAST")),"^",3)
96 S RXP=+$P($G(^XTMP(NAMSP,0,"LAST")),"^",4)
97 ;
98 ;get 1st occurence of install date of patch PSO*7*143 (CIDC)
99 S XIEN=+$O(^XPD(9.7,"B","PSO*7.0*143",0))
100 S:'PSODT PSODT=+$P($G(^XPD(9.7,XIEN,1)),"^",3)
101 I 'PSODT D Q
102 . S ^XTMP(NAMSP,0,.1)="CIDC PATCH PSO*7*143 IS NOT INSTALLED"
103 . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="COMPLETED^"_$$NOW^XLFDT
104 . D MAIL3^PSOCIDC8(^XTMP(NAMSP,0,.1))
105 ;
106 S (PSOTRX,PSOTRF)=1
107 N STOP K ^XTMP(NAMSP,0,"STOP") S STOP=0 ;init stop flag to 0
108 F CC=1:1 S PSODT=$O(^PSRX("AD",PSODT)) Q:'PSODT D Q:STOP ;FINISH DATE
109 . I $D(^XTMP(NAMSP,0,"STOP")) D Q
110 . . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="STOP^"_$$NOW^XLFDT,STOP=1
111 . F PSOTRX=PSOTRX+1:1 S RXP=$O(^PSRX("AD",PSODT,RXP)) Q:'RXP D Q:STOP
112 .. I $D(^XTMP(NAMSP,0,"STOP")) D Q
113 ... S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="STOP^"_$$NOW^XLFDT,STOP=1
114 ..; S RXP=392 D Q:RXP=392 ;FOR TESTING INDIVIDUAL
115 .. Q:'$D(^PSRX(RXP,"ICD",0))
116 .. ;save last date & fill info
117 .. S $P(^XTMP(NAMSP,0,"LAST"),"^",3,5)=PSODT_"^"_RXP_"^"_PSOTRX
118 .. S (DFN,PSODFN)=$P($G(^PSRX(RXP,0)),"^",2)
119 .. S PSONAM=$P($G(^DPT(PSODFN,0)),"^"),PSONAM=$P(PSONAM,",")
120 .. Q:('PSODFN)!('$D(^DPT(PSODFN,0))) ;quit, no valid DFN info
121 .. D:$D(^PSRX(RXP,"A",0))!($D(^PSRX(RXP,"COPAY",0))) CHECK^PSOCIDC8
122 G STP:STOP
123 ;
124 S (PSOUCNT,PSOCNT,PSOCCNT)=0
125 S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="COMPLETED^"_$$NOW^XLFDT
126 D MAIL^PSOCIDC8
127STP ;
128 L -^XTMP(NAMSP)
129 I $D(^XTMP(NAMSP,0,"STOP")) S ^XTMP(NAMSP,0,"ZAUDIT",$H)="STOPPED ON"_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
130 S:$D(ZTQUEUED) ZTREQ="@"
131 K JOBN
132 Q
133 ;
134 ;
135STATUS ;show status of job running
136 I $$ST D
137 . W !,"Currently processing:"
138 . I $G(^XTMP($$NAMSP,0,"LAST"))["COMPLETED" D
139 . . W !,"COMPLETED ON ",$$FMTE^XLFDT($P($G(^XTMP($$NAMSP,0,"LAST")),"^",2)),!
140 . W !?5,"Date being processed > ",$$FMTE^XLFDT($P(^XTMP($$NAMSP,0,"LAST"),"^",3))
141 . W !?5," RX # > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",4)
142 . ;W !?5," TOTAL RX's > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",5),!
143 E D
144 .I $G(^XTMP($$NAMSP,0,"LAST"))["COMPLETED" D
145 .. W !,"COMPLETED ON ",$$FMTE^XLFDT($P($G(^XTMP($$NAMSP,0,"LAST")),"^",2)),!
146 Q
147 ;
148STOP ;stop job command
149 I $$ST S ^XTMP($$NAMSP,0,"STOP")="" D
150 . W !,"Outpatient Activity Logs Correction Job - set to STOP Soon"
151 . W !!,"Check Status to be sure it has stopped and is not running..."
152 . W !," (D STATUS^PSOCIDC7)"
153 Q
154ST() ;status
155 L +^XTMP($$NAMSP):3 I $T D Q 0
156 . L -^XTMP($$NAMSP)
157 . W !,"*** NOT CURRENTLY RUNNING! ***",!
158 Q 1
159INITXTMP(NAMSP,TITLE,LIFE) ;create ^Xtmp according to SAC std
160 N BEGDT,PURGDT
161 S BEGDT=$$NOW^XLFDT()
162 S PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
163 S ^XTMP(NAMSP,0)=PURGDT_"^"_BEGDT_"^"_TITLE
164 Q
165NAMSP() ;
166 Q $T(+0)
Note: See TracBrowser for help on using the repository browser.