source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG53659.m@ 677

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

initial load of FOIAVistA 6/30/08 version

File size: 4.7 KB
Line 
1DG53659 ;EG - DG*5.3*659 Cleanup Radiation Exposure; 08/08/2006
2 ;;5.3;Registration;**659**;Aug 13,1993;Build 20
3 ;
4POST ;
5 N U,ZTRTN,ZTDESC,ZTSAVE,ZTIO,ZTSK,ZTDTH
6 S U="^"
7 D BMES^XPDUTL("Queue-ing the job to reset Radiation Exposure Method...")
8 S ZTRTN="RUN^DG53659",ZTDESC="Reset Radiation Exposure Method"
9 S ZTIO="",ZTDTH=$$NOW^XLFDT D ^%ZTLOAD
10 D BMES^XPDUTL("This request queued as Task # "_$G(ZTSK))
11 D BMES^XPDUTL("=====================================================")
12 D BMES^XPDUTL("")
13 Q
14EP ; Queue the conversion
15 N %
16 S %=$$NEWCP^XPDUTL("IEN12","RUN^DG53659(1)")
17 S %=$$NEWCP^XPDUTL("END","END^DG53659") ; Leave as last update
18 Q
19 ;
20END ; Post-install done
21 D BMES^XPDUTL("Post install complete.")
22 Q
23RUN ;entry point from taskman
24 I '$$CHKSTAT(1) D Q
25 . D BMES^XPDUTL("Conversion routine already running, process aborted")
26 . Q
27 N TESTING
28 S TESTING="N" K ^TMP($$NAMSPC) D QUE
29 Q
30TEST ;entry point for test mode
31 N TESTING,X,STARTID,ENDID,U,NAMSPC
32 S NAMSPC=$$NAMSPC
33 S TESTING="Y",U="^"
34 S X=$$CHKSTAT(0)
35 K ^XTMP(NAMSPC,"TEST RANGE"),^XTMP(NAMSPC,"TEST")
36 S STARTID=$$TESTID("Starting")
37 S ENDID=$$TESTID("Ending")
38 I ENDID<STARTID U 0 W !,?10,"Ending IEN can't be less than starting IEN"
39 S ^XTMP(NAMSPC,"TEST RANGE")=STARTID_U_ENDID
40 D QUE
41 Q
42 ;
43TESTID(MESS) ;
44TESTIDG N X
45 U 0 W !!,MESS," DFN for Patient file? " R X:300
46 I X="" Q X
47 I X'?1N.N,X'?1N.N1"."1N.N W !,?10,"Must be numeric" G TESTIDG
48 Q X
49 ;
50QUE ;
51 N ZTSTOP,X,U,NAMSPC
52 S U="^"
53 I '$D(TESTING) N TESTING S TESTING="N"
54 S NAMSPC=$$NAMSPC
55 S X=$$SETUPX(90)
56 S X=$G(^XTMP(NAMSPC,0,0))
57 S $P(X,U,6)="RUNNING"
58 S $P(X,U,7)=$$NOW^XLFDT
59 S ^XTMP(NAMSPC,0,0)=X
60 ;
61 S X=$$LOOP(NAMSPC,TESTING),ZTSTOP=$P(X,U,2)
62 S X=$G(^XTMP(NAMSPC,0,0))
63 S $P(X,U,6)=$S(ZTSTOP:"STOPPED",1:"COMPLETED")
64 S $P(X,U,8)=$$NOW^XLFDT
65 S ^XTMP(NAMSPC,0,0)=X
66 ;
67 S X=$$MAIL^DG53659M(NAMSPC,TESTING,DUZ)
68 K TESTING
69 L -^XTMP(NAMSPC)
70 Q
71 ;
72SETUPX(EXPDAYS) ;
73 ; requires EXPDAYS - number of days to keep XTMP around
74 N BEGTIME,PURGDT,NAMSPC,U
75 S U="^"
76 S NAMSPC=$$NAMSPC
77 S BEGTIME=$$NOW^XLFDT()
78 S PURGDT=$$FMADD^XLFDT(BEGTIME,EXPDAYS)
79 S ^XTMP(NAMSPC,0)=PURGDT_U_BEGTIME
80 S $P(^XTMP(NAMSPC,0),U,3)="Convert Radiation Exposure Method"
81 Q 1
82 ;
83LOOP(NAMSPC,TESTING) ;
84 ;returns 0^stop flag
85 N X,XREC,LASTREC,TOTREC,TOTPAT
86 N U,ZTSTOP,REXP
87 S LASTREC="",U="^",ZTSTOP=0
88 S TOTREC=0
89 I $D(^XTMP(NAMSPC,0,0)) D
90 . S XREC=$G(^XTMP(NAMSPC,0,0))
91 . ;last DFN processed
92 . S LASTREC=+$P(XREC,U,1)
93 . ;total records read
94 . S TOTREC=+$P(XREC,U,2)
95 . S TOTPAT=+$P(XREC,U,10)
96 . Q
97 D DFN
98 Q 0_"^"_ZTSTOP
99 ;
100DFN N DFN,END,X
101 S DFN="",END=9999999999999999999999
102 S X=$G(^XTMP(NAMSPC,"TEST RANGE")) I $L(X) D
103 . S DFN=$P(X,U,1)-1,END=$P(X,U,2)
104 . Q
105 S ZTSTOP=0
106 F S DFN=$O(^DPT(DFN)) Q:DFN=""!ZTSTOP!(DFN?1A.E) D CHKR
107 Q
108 ;
109CHKR N X,U,NEW
110 S U="^"
111 I DFN>END S ZTSTOP=2 Q
112 S LASTREC=DFN
113 S TOTREC=TOTREC+1
114 I (TOTREC#20)=0 S ZTSTOP=$$STOP(NAMSPC) I ZTSTOP=1 Q
115 S X=$$CHPAT(DFN) I $P(X,U,1)="Y" D
116 . S NEW=$P(X,U,2),TOTPAT=TOTPAT+1
117 . I TESTING="N" D
118 . . N DA,DIE,DR,X
119 . . S DA=DFN,DIE="^DPT(",DR=".3212////"_NEW
120 . . D ^DIE
121 . . Q
122 . Q
123 S X=$$UPDATEX(NAMSPC,TOTREC,LASTREC,TOTPAT)
124 Q
125CHPAT(DFN) ;
126 N X,U,RET,VAL
127 S U="^",RET="N"
128 S X=$G(^DPT(DFN,.321))
129 S VAL=$P(X,U,12)
130 I VAL?1N,VAL>1,VAL<8 Q RET
131 I $L(VAL) D
132 . I $P($G(^DPT(DFN,.321)),U,3)="Y" S RET="Y^"_$S(VAL="N":2,VAL="T":3,VAL="B":4,1:3) Q
133 . ;if radiation exposure indicated is set to 'No', delete radiation exposure method
134 . S RET="Y^@"
135 . Q
136 ;bulk fill to 3 if radiation exposure method is null
137 ;and radiation exposure indicated is "Y"
138 I '$L(VAL),$P($G(^DPT(DFN,.321)),U,3)="Y" D
139 . S RET="Y^3"
140 . Q
141 Q RET
142 ;
143UPDATEX(NAMSPC,TOTREC,LASTREC,TOTPAT) ;
144 N X,U
145 S U="^",X=$G(^XTMP(NAMSPC,0,0))
146 S $P(X,U,1)=$G(LASTREC),$P(X,U,2)=$G(TOTREC)
147 S $P(X,U,10)=$G(TOTPAT)
148 S ^XTMP(NAMSPC,0,0)=X
149 Q 1
150STATUS ;display status of current run
151 N X,NAMSPC,U,OLD
152 S U="^"
153 S NAMSPC=$$NAMSPC
154 S X=$G(^XTMP(NAMSPC,0,0))
155 I X="" U 0 W !!,"Task not started!!!" Q
156 W !!," Current status: ",$P(X,U,6)
157 W !," Starting time: ",$$FMTE^XLFDT($P(X,U,7))
158 I $P(X,U,8) D
159 . W !," Ending time: ",$$FMTE^XLFDT($P(X,U,8))
160 . Q
161 W !!," Total patient records read: ",$P(X,U,2)
162 W !," Last patient record processed: ",$P(X,U,1)
163 W !," Total patient records changed: ",$P(X,U,10)
164 Q
165 ;
166STOP(NAMSPC) ;
167 N ZSTSTOP,U,X
168 S U="^"
169 ;returns stop flag
170 S ZTSTOP=0
171 I $$S^%ZTLOAD S ZTSTOP=1
172 I $D(^XTMP(NAMSPC,"STOP")) S ZTSTOP=1 K ^XTMP(NAMSPC,"STOP")
173 I ZTSTOP D
174 . S X=$G(^XTMP(NAMSPC,0,0))
175 . S $P(X,U,6)="STOPPED",$P(X,U,7)=$$NOW^XLFDT
176 . S ^XTMP(NAMSPC,0,0)=X
177 . Q
178 Q ZTSTOP
179CHKSTAT(POST) ;check if job is running, stopped, or complete
180 N NAMSPC
181 S NAMSPC=$$NAMSPC
182 L +^XTMP(NAMSPC):1
183 I '$T Q 0
184 D KILIT
185 Q 1
186 ;
187 ;
188KILIT ;
189 S:'$D(NAMSPC) NAMSPC=$$NAMSPC
190 I 'POST K ^XTMP(NAMSPC)
191 Q
192NAMSPC() ;
193 Q $T(+0)
194 ;
Note: See TracBrowser for help on using the repository browser.