source: cprs/branches/tmg-cprs/m_files/TMGFIX.m.old@ 1117

Last change on this file since 1117 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload
File size: 6.2 KB
Line 
1
2
3
4;"=====================================================================
5;"================================================================
6
7ENV ;Establish Routine Environment
8 N DDH,DIR,X,Y,ZTENV,ZTKEY,ZTNAME,ZTSK,XUTMUCI
9 D ENV^XUTMUTL Q:'$D(ZTENV)
10 ;
11 new DIC,X,Y
12 set DIC=.401
13 set DIC(0)="MAEQ"
14 do ^DIC write !
15 if +Y'>0 quit
16 new templIEN set tempLIEN=+Y
17 new IEN set IEN=""
18 for set IEN=$order(^DIBT(tempLIEN,1,IEN)) quit:IEN="" do
19 . do KILLTSK(IEN)
20
21 quit
22
23
24KILLTSK(ZTSK)
25 ;"W !
26 ;"S XUTMT(0)="AL"
27 ;"D ^XUTMT
28 I 'ZTSK K ^TMP($J,"XUTMT") Q
29 ;"I ZTSK["-"!(ZTSK[",") D ^XUTMD1 Q:$D(DTOUT) G SELECT
30 S XUTMT=ZTSK,XUTMT(0)="R3"
31 D ^XUTMT
32 ;
33STATUS ;Report On Status Of Task And Whether User May Delete It
34 I $D(ZTSK(.11))#2,ZTSK(.11)="UNDEFINED",$O(ZTSK(.3))="" W !!?5,"That task is not defined.",$C(7) G SELECT
35 I $D(ZTSK(.11))#2,ZTSK(.11)="UNDEFINED",$O(ZTSK(.3))="TASK",$O(ZTSK("TASK"))="" W !!?5,"That task is running and has no record." G SELECT
36 I $D(ZTSK(.11))#2,ZTSK(.11)="UNDEFINED" W !!?5,"That task is scheduled but has no record." G CONFIRM:ZTKEY G SELECT
37 ;
38S5 I $D(ZTSK(.11))#2,$O(ZTSK(.3))="" W !!?5,"That task's record is incomplete." G CONFIRM:ZTKEY G SELECT
39 I $D(ZTSK(.11))#2,$O(ZTSK(.3))="TASK",$O(ZTSK("TASK"))="" W !!?5,"That task is running and has an incomplete record." G SELECT
40 I $D(ZTSK(.11))#2 W !!?5,"That task is scheduled, but has an incomplete record." G CONFIRM:ZTKEY G SELECT
41 ;
42S9 I $O(ZTSK(.3))="TASK",$O(ZTSK("TASK"))="" W !!?5,"That task is running." G SELECT
43 I 'ZTKEY,$S($P(ZTSK(0),U,11)_","_$P(ZTSK(0),U,12)=XUTMUCI:DUZ'=$P(ZTSK(0),U,3),1:ZTNAME'=$P(ZTSK(0),U,10)) W !!?5,"You may only delete your own tasks." G SELECT
44 ;
45CONFIRM ;Prompt User To Confirm Unscheduling
46 I $S($D(ZTSK(.11))[0:1,1:ZTSK(.11)'="UNDEFINED") W ! D EN^XUTMTP(ZTSK)
47 ;"W !
48 ;"K DIR
49 ;"S DIR(0)="Y"
50 ;"S DIR("A")="Are you sure you want to delete this task"
51 ;"S DIR("B")="NO"
52 ;"S DIR("?")=" Answer YES to delete the task."
53 ;"D ^DIR
54 ;"I 'Y W !!?5,"Tasks NOT deleted!"
55 ;"I $D(DTOUT) W $C(7) Q
56 ;"K DIR,DIRUT,DTOUT,DUOUT
57 ;"I 'Y G SELECT
58 ;
59DELETE ;Delete Task
60 I $D(ZTSK(0))#2,ZTSK(0)["ZTSK^XQ1",$P(ZTSK(0),U,11)_","_$P(ZTSK(0),U,12)=XUTMUCI,$P(ZTSK(0),U,8)]"" D
61 . F DA=0:0 S DA=$O(^DIC(19.2,DA)) Q:DA'>0 I $G(^DIC(19.2,DA,1))=ZTSK D
62 . . N DIE S DIE="^DIC(19.2,",DR="2///@;12///@" D ^DIE Q
63 . Q
64 S XUTMT=ZTSK,XUTMT(0)="D"
65 D ^XUTMT
66 W !!?5,"Deleted!"
67 G SELECT
68 ;
69
70SELECT
71 quit
72
73
74loop1
75 new count set count=0
76 new DA set DA=0
77 for set DA=$order(^PSDRUG(DA)) quit:(+DA'>0) do
78 . set count=count+1
79 . if count#100=0 write "."
80 . I '$G(^PSDRUG(DA,"ND")) quit
81 . new ien set ien=$P(^("ND"),"^",3)
82 . if ien="" write "problem with ien. DA=",DA,! quit
83 . S NEWC1=$P(^PSNDF(50.68,ien,3),"^")
84 . if NEWC1="" do quit
85 . . write !,"File 50, IEN #",DA," points to 50.68 (VA PRODUCT) entry IEN #",ien,",",!
86 . . write "However, in File 50.68, IEN #",ien,", field 15 (primary drug class) is NULL",!
87 . set NEWC=$P(^PS(50.605,NEWC1,0),"^",1)
88 . set DIE="^PSDRUG(",DR="2////"_NEWC_";25////"_NEWC1_";"
89
90 write !,"done.",!
91 quit
92
93loop2
94 new max set max=$piece($get(^PSDRUG(0)),"^",4)
95 new startTime set startTime=$H
96 new DA
97 S DA=0 F S DA=$O(^PSDRUG(DA)) Q:'DA I $D(^(DA,0)) D
98 . ;"if DA#10=0 do ProgressBar^TMGUSRIF(DA,"",0,max,60,startTime)
99 . new skip set skip=0
100 . I $G(^PSDRUG(DA,"ND")) do quit:(skip)
101 . . new ien50d68 set ien50d68=+$P(^("ND"),"^",3)
102 . . if ien50d68=0 do quit
103 . . . set skip=1
104 . . . write "DRUG (50) file IEN #",DA," does not have a pointer>0 in field 22",!
105 . . S NEWC1=$P($get(^PSNDF(50.68,ien50d68,3)),"^")
106 . . if +NEWC1=0 do quit
107 . . . set skip=1
108 . . . ;"write "VA PRODUCT (50.68) file IEN #",ien50d68," does not have pointer in field 15",!
109 . . . ;"write "Here is $get(^PSNDF(50.68,ien50d68,3)): ",$get(^PSNDF(50.68,ien50d68,3)),!
110 . . . write ien50d68,!
111 . . set NEWC=$P($get(^PS(50.605,NEWC1,0)),"^",1)
112 . . if NEWC="" do quit
113 . . . set skip=1
114 . . . write "VA DRUG CLASS (50.605) file IEN #",NEWC1," does not have a drug code (.01 field)!",!
115 . . . write !,"Problem (A): ^PSDRUG, DA=",DA,!
116 . . set DIE="^PSDRUG(",DR="2////"_NEWC_";25////"_NEWC1_";"
117 . . ;"D ^DIE Q
118
119 quit
120
121
122
123loop3
124 ;"Purpose: Allow user to browse classes with selector
125 ;"Input: none
126 ;"Results: none
127
128 new Options,IEN
129 set Options("FIELDS",1)=".01^NAME^60"
130 set Options("FIELDS",1,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit
131 set Options("FIELDS",2)="15^VA DRUG CLASS^20"
132 set Options("FIELDS",2,"LOOKUP FN")="$$SECLookup^TMGNDF3A()"
133 set Options("FIELDS","MAX NUM")=2
134 set Options("FILE")="50.68^VA PRODUCT"
135 ;"Get all records with SKIP THIS RECORD = 0 (KEEP)
136
137 set Options("IEN LIST",29446)=""
138 set Options("IEN LIST",29555)=""
139 set Options("IEN LIST",29956)=""
140 set Options("IEN LIST",33448)=""
141 set Options("IEN LIST",69944)=""
142 set Options("IEN LIST",69993)=""
143 set Options("IEN LIST",70005)=""
144 set Options("IEN LIST",70070)=""
145 set Options("IEN LIST",70447)=""
146 set Options("IEN LIST",70501)=""
147 set Options("IEN LIST",70519)=""
148 set Options("IEN LIST",70553)=""
149 set Options("IEN LIST",70841)=""
150 set Options("IEN LIST",70935)=""
151 set Options("IEN LIST",70937)=""
152 set Options("IEN LIST",71060)=""
153 set Options("IEN LIST",71063)=""
154 set Options("IEN LIST",71094)=""
155 set Options("IEN LIST",71134)=""
156 set Options("IEN LIST",71317)=""
157 set Options("IEN LIST",71492)=""
158 set Options("IEN LIST",71593)=""
159 set Options("IEN LIST",72010)=""
160
161E1
162 if $$SELED^TMGSELED(.Options)'=2
163
164 write "done",!
165 quit
Note: See TracBrowser for help on using the repository browser.