source: FOIAVistA/trunk/r/CMOP-PSX/PSXAUTO.m@ 914

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

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1PSXAUTO ;BIR/WPB-Routine to Automatically Run CMOP Suspense ;14 DEC 2001
2 ;;2.0;CMOP;**1,2,3,24,28,36,41**;11 Apr 97
3 ;Reference to ^XUSEC( supported by DBIA #10076
4 ;This routine will be called from a menu option and will allow
5 ;the user to start or change auto-processing. The user must hold
6 ;the PSXAUTOX security key.
7 G START
8STARTCS ; entry from edit auto CS Schedule menu option (future - post *41))
9 S PSXCS=1
10START ;
11 S PSXCS=+$G(PSXCS)
12 I '$D(^XUSEC("PSXAUTOX",DUZ)) W !,"You are not authorized to use this option!" Q
13 I '$D(^XUSEC("PSX XMIT",DUZ)) W !,"You are not authorized to use this option!" Q
14 I '$D(^XUSEC("PSXCMOPMGR",DUZ)) W !,"You are not authorized to use this option!" Q
15 D SET^PSXSYS I $G(PSXSYS)="" W !!,"The Station number is missing in the Institution file.",!,"The Station number is required for CMOP transmissions.",!,"Please contact your IRM and have this problem corrected, then try again." Q
16 I '$D(^PSX(550,"C")) W !,"The CMOP is not an active CMOP site and can not schedule auto transmissions." Q
17 I $D(^PSX(550,"TR","T")) W !,"A transmission is in progress, try later." Q
18 L +^PSX(550.1):5 I '$T W !,"A transmission is in progress, try later." Q
19 S PSXSTAT="T" D PSXSTAT^PSXRSYU I $G(PSXLOCK) G EXIT
20 S PSXDUZ=DUZ
21 F PSXCS=0,1 D GETSCH S DTTM(PSXCS)=PSXDATE ; store pre-edit schedule values
22ASK D EDTBSCH ; edit both schedules
23FILE ; if either schedule changed send appropriate message
24 F PSXCS=0,1 D GETSCH D
25 . I DTTM(PSXCS)=PSXDATE Q ;no change - quit
26 . I 'PSXDATE,DTTM(PSXCS) S (PSXAUTO,PSXHOUR)=0 D AUTOMSG^PSXMSGS,SERV^PSXMISC W !,$S(PSXCS:"",1:"NON-"),"CS Cancel Schedule Sent to CMOP" H 3 Q ; schedule deleted
27 . S PSXAUTO=1 D AUTOMSG^PSXMSGS,SERV^PSXMISC W !,$S(PSXCS:"",1:"NON-"),"CS New Schedule Sent to CMOP" H 3 ; new/changed schedule to send
28 K DTTM
29 G EXIT
30 ;
31ENCS ; entry from auto CS Tasking Option Schedule (future-post *41)
32 S PSXCS=1
33EN ;Entry from Kernel Option Tasking NON-CS
34 S PSXCS=+$G(PSXCS)
35 Q:'$D(^PSX(550,"C")) ;no CMOP selected M xref
36 Q:'$D(^PSX(550,"ST","A")) ;no CMOP selected Regular xref
37 S ZTSK=$G(ZTSK),PSXZTSK=ZTSK,PSXCS=+$G(PSXCS)
38 ; test if previous job still running
39LOCK ; >>>**** LOCK OF FILE 550.1 ****<<<
40 L +^PSX(550.1):60 I '$T D RQUEMSG G EXIT ; no lock then reque 30 minutes later
41 ;if a lock is obtainable , no transmission is running
42TFLAG I $D(^PSX(550,"TR","T")) D G TFLAG ;clear 'T' flags
43 . D ^PSXRCVRY
44 . N PSXSYS S PSXSYS=$O(^PSX(550,"TR","T",0)) S PSXSTAT="H" D PSXSTAT^PSXRSYU
45 ; proceeding to process files
46 D SET^PSXSYS Q:$P(PSXSYS,"^",2)=""
47 I $D(^PSX(550.2,"AQ")) D EN1^PSXRCVRY
48 ; set running task into 550 RUNNING TASK
49 K DIC,DIE,DR,DA S DIE=550,DA=+PSXSYS,DR="9////"_$G(ZTSK) D ^DIE K DIC,DIE,DR,DA
50 ; proceed tp process, setup variables, call into LOCK^PSXRSUS
51 S XX=$S('PSXCS:11,1:12) S THRU=+$$GET1^DIQ(550,+PSXSYS,XX)
52 S TPRTDT=DT S:$G(THRU)>0 TPRTDT=$$FMADD^XLFDT(DT,THRU,0,0,0)
53 S PSXDIVML=1,PSXFLAG=1,PSXTRANS=1,PSOINST=$P(PSXSYS,"^",2)
54 G LOCK^PSXRSUS
55 ;
56EDTBSCH ; display/edit both schedules as they are interactive with each other
57 W @IOF D DSPSCH
58 K DIR S DIR(0)="SO^C:Controlled Substance;N:NON-Controlled Substance;",DIR("A")="Edit CS <C> or NON-CS <N> "
59 D ^DIR K DIR
60 I Y'="C",Y'="N" Q
61 N PSXCS
62 S PSXCS=$S(Y="C":1,1:0)
63 D EDIT
64 G EDTBSCH
65 ;
66EDIT ;Edit scheduling of transmissions and parameter "Number of days to transmit"
67 ;schedules must be separated by 2 hours
68 S PSXCS=+$G(PSXCS)
69 S XX=$S($G(PSXCS):"PSXR SCHEDULED CS TRANS",1:"PSXR SCHEDULED NON-CS TRANS")
70 D EDIT^XUTMOPT(XX)
71 I '$D(PSXSYS) D SET^PSXSYS
72 I +PSXSYS S DIE=550,DR="11",DA=+PSXSYS S:PSXCS DR="12" D ^DIE
73 ;check for 2 hour difference
74 I $$CHKSCH() Q ; 2 hour difference satisfied
75 W @IOF,!,"Sorry, there has to be at least 2 hours between the daily transmission runs.",!
76 D DELSCH
77 W !! K DIR S DIR(0)="E",DIR("A")="The "_$S(PSXCS:"CS",1:"NON-CS")_" schedule has been cleared for RE-EDIT. <cr>" D ^DIR
78 Q
79 ;
80CHKSCH() ;CHECK Task schedules for 2 hour difference
81 N PSXCS,CSTSK,CSDATE,CSTHRU,CSHOUR,NCSTSK,NCSDATE,NCSTHRU,NCSHOUR,TSDIF
82 S PSXCS=1 D GETSCH
83 S CSTSK=+TSK(1),CSDATE=PSXDATE,CSHOUR=PSXHOUR,CSTHRU=THRU
84 S PSXCS=0 D GETSCH
85 S NCSTSK=+TSK(1),NCSDATE=PSXDATE,NCSHOUR=PSXHOUR,NCSTHRU=THRU
86 I NCSTSK,CSTSK I 1
87 E Q 1 ; quit test if either is not scheduled
88 S CSDATE=(CSDATE#1)+DT,NCSDATE=(NCSDATE#1)+DT
89 S X1=CSDATE,X2=NCSDATE
90 I CSDATE>NCSDATE S X1=NCSDATE,X2=CSDATE
91 S TSDIF=$$FMDIFF^XLFDT(X2,X1,2)
92 ;W ! ZW X1,X2,XX,NCSDATE,CSDATE H 5
93 I TSDIF<7200 Q 0
94 I TSDIF>79200 Q 0
95 Q 1
96 ;
97DELSCH ;Delete startup time and its pending task
98 S PSXCS=+$G(PSXCS)
99 S XX=$S($G(PSXCS):"PSXR SCHEDULED CS TRANS",1:"PSXR SCHEDULED NON-CS TRANS")
100 D RESCH^XUTMOPT(XX,"@")
101 D:'+PSXSYS SET^PSXSYS
102 Q
103 ;
104GETSCH ; get schedule information from Kernel Option Scheduling
105 S PSXCS=+$G(PSXCS)
106 D:'$D(PSXSYS) SET^PSXSYS
107 S XX=$S($G(PSXCS):"PSXR SCHEDULED CS TRANS",1:"PSXR SCHEDULED NON-CS TRANS")
108 K TSK D OPTSTAT^XUTMOPT(XX,.TSK) S TSK(1)=$G(TSK(1))
109 S (PSXDATE,PSXHOUR,THRU)=""
110 S PSXZTSK=+TSK(1),PSXDATE=$P(TSK(1),U,2),PSXHOUR=$P(TSK(1),U,3)
111 S XX=$S('PSXCS:11,1:12) S THRU=$$GET1^DIQ(550,+PSXSYS,XX)
112 Q
113 ;
114DSPSCH ;Display schedules for transmissions
115 N PSXCS,CSTSK,CSDATE,CSTHRU,CSHOUR,NCSTSK,NCSDATE,NCSTHRU,NCSHOUR
116 S PSXCS=1 D GETSCH
117 S CSTSK=+TSK(1),CSDATE=PSXDATE,CSHOUR=PSXHOUR,CSTHRU=THRU
118 S PSXCS=0 D GETSCH
119 S NCSTSK=+TSK(1),NCSDATE=PSXDATE,NCSHOUR=PSXHOUR,NCSTHRU=THRU
120 S Y=CSDATE X ^DD("DD") S CSDATE=Y S Y=NCSDATE X ^DD("DD") S NCSDATE=Y
121 W !,?25,"CS Transmission",?55,"Non-CS Transmission"
122 W !,"Scheduled to Run",?25,CSDATE,?55,NCSDATE
123 W !,"Frequency (hrs)",?25,CSHOUR,?55,NCSHOUR
124 W !,"Thru days",?25,CSTHRU,?55,NCSTHRU
125 W !,"Tasking ID",?25,CSTSK,?55,NCSTSK
126 Q
127 ;
128RQUEMSG ; lock on 550.1 not achieved send transmission requeued message
129 S PSXCS=+$G(PSXCS)
130 S ZTSAVE("PSXCS")=""
131 D NOW^%DTC
132 S ZTDTH=$$FMADD^XLFDT(%,,,30)
133 S Y=% X ^DD("DD") S DTTM=Y
134 S ZTDESC="CMOP "_$S(PSXCS:"",1:"NON-")_"CS AUTO TRANSMISSION REQUEUE"
135 S ZTRTN="EN^PSXAUTO",ZTIO=""
136 D ^%ZTLOAD
137 S XMDUZ="Postmaster",XMSUB=$S($G(PSXCS):"",1:"NON-")_"CS Scheduled Transmission RE-Queued"
138 S XMTEXT="TXT("
139 S TXT(1,0)="The "_$S($G(PSXCS):"",1:"NON-")_"CS Scheduled Transmission for "_DTTM
140 S TXT(2,0)="was re-queued with task # "_ZTSK_" to run again in 30 minutes."
141 S TXT(3,0)="It could not obtain a lock on the RX QUEUE file #550.1."
142 S TXT(4,0)="That indicates that a transmission was in progress."
143 S TXT(5,0)=" "
144 S TXT(6,0)="If you are getting this message frequently, please contact your IRM Group"
145 D GRP1^PSXNOTE
146 ;S XMY(DUZ)=""
147 D ^XMD
148 Q
149EXIT ;
150 L -^PSX(550.1)
151 D:'$D(PSXSYS) SET^PSXSYS
152 S PSXSTAT="H" D PSXSTAT^PSXRSYU
153 K TIME,STDATE,NUM,X,Y,FREQ,PSXZTSK,START,ZTSK,%,%DT,DTE,LCNT,LL,N,RECD,RR,SITE,XMDUN,XMDUZ,XMSUB,XMZ,PSXDUZ,PSXAUTO,PSXDATE,PSXHOUR,DTTM
154 K ZTSAVE,ZTDESC,ZTRTN,ZTIO,ZTREQ,ZTDTH,SDATE,DIR,DIRUT,DUOUT,DTOUT
155 K PSXSYS,DIROUT,THRU,NEXT,RE,PSXLOCK,XX,PSXXDIV
156 S ZTREQ="@"
157 Q
158STOPET ; set a stop auto-error-trap node
159 S ^XTMP("PSXAUTOERR")=DT_"^"_DT_"^AUTO ERROR TRAP STOP NODE"
160 Q
161STARTET ; remove any stop node
162 K ^XTMP("PSXAUTOERR")
163 Q
Note: See TracBrowser for help on using the repository browser.