source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWUL.m@ 1608

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

initial load of FOIAVistA 6/30/08 version
File size: 7.2 KB
Line 
1ORWUL ; SLC/KCM/JLI - Listview Selection ;1/25/02 14:09 [2/4/02 12:23pm] 2/27/06
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,117,131,132,164,215,245**;Dec 17, 1997;Build 2
3 ;
4QV4DG(VAL,DGRP) ; return the quick order list, given a display group name
5 N NM
6 S VAL="0^0"
7 I 'DGRP S DGRP=+$O(^ORD(100.98,"B",DGRP,0))
8 S NM=$$GET^XPAR("ALL","ORWDQ QUICK VIEW",DGRP,"I")
9 Q:'$L(NM)
10 D QV4NM(.VAL,NM)
11 Q
12QV4NM(VAL,QVNAM) ; return the current quick list and item count
13 ; VAL: ListIEN^ItemCount
14 N J,CNT ;117
15 S VAL=+$O(^ORD(101.44,"B",QVNAM,0))
16 S (J,CNT)=0 F S J=$O(^ORD(101.44,VAL,10,J)) Q:'+J I '$$QODIS(VAL,J) S CNT=CNT+1 ;117
17 S $P(VAL,U,2)=CNT ;117
18 Q
19QVSUB(LST,IEN,FIRST,LAST) ; return subset of orders in view
20 N I,J,ID ;117
21 I $L(FIRST),$L(LAST) D
22 . F I=+FIRST:1:+LAST D
23 .. I $D(^ORD(101.44,IEN,10,I,0))>0 D
24 ... I '$$QODIS(IEN,I) S LST(I)=^ORD(101.44,IEN,10,I,0)
25 E D
26 . S (I,J)=0 F S I=$O(^ORD(101.44,IEN,10,I)) Q:'+I I '$$QODIS(IEN,I) S J=J+1,LST(J)=^ORD(101.44,IEN,10,I,0) ;117
27 Q
28QODIS(IEN,SUB) ;Determines if personal quick order is disabled
29 ;returns 1 if it is else 0. This section added with patch 117
30 I $P($G(^ORD(101.41,+$P($G(^ORD(101.44,IEN,10,SUB,0)),"^"),0)),"^",3)'="" Q 1
31 Q 0
32QVIDX(VAL,IEN,FROM) ; return index of item beginning with FROM
33 N I,X
34 S VAL=0
35 S X=$O(^ORD(101.44,IEN,10,"C",FROM))
36 I '$L(X) Q
37 S I=$O(^ORD(101.44,IEN,10,"C",X,0))
38 Q:'I
39 S:'$$QODIS(IEN,I) VAL=+I_U_X
40 Q
41FV4DG(VAL,DGNM) ; return the current full list & item count
42 S VAL=$O(^ORD(101.44,"B","ORWDSET "_DGNM,0))
43 I 'VAL D
44 . N UPDTIME,ATTEMPT
45 . S UPDTIME=$G(^ORD(101.43,"AH","S."_DGNM)),ATTEMPT=0
46 . I UPDTIME="" S UPDTIME=$H,^ORD(101.43,"AH","S."_DGNM)=UPDTIME
47 . D FVBLD
48 . S VAL=$O(^ORD(101.44,"B","ORWDSET "_DGNM,0))
49 I ($P(^ORD(101.44,+VAL,0),U,6)'=$G(^ORD(101.43,"AH","S."_DGNM))) D
50 . ; -- see if a task is already queued to rebuild this
51 . L +^XTMP("ORWDSET "_DGNM):2 E Q
52 . N ZTSK S ZTSK=+$G(^XTMP("ORWDSET "_DGNM,"TASK"))
53 . I ZTSK D ISQED^%ZTLOAD S ZTSK=+ZTSK(0)
54 . I ZTSK L -^XTMP("ORWDSET "_DGNM) Q
55 . ; -- create a task to rebuild the list
56 . D FVBLDQ(DGNM)
57 . L -^XTMP("ORWDSET "_DGNM)
58 S $P(VAL,U,2)=$P($G(^ORD(101.44,+VAL,20,0)),U,4)
59 Q
60FVSUB(LST,IEN,FIRST,LAST) ; return subset of orders in view
61 N I
62 F I=FIRST:1:LAST D
63 .;AGP change returned valued to returned data or @ if record does not
64 .;exist. The @ sign is used by the delphi code to identified a
65 .;non-existence record
66 .S LST(I)=$S($D(^ORD(101.44,IEN,20,$G(I)))>0:^ORD(101.44,IEN,20,I,0),1:"@")
67 Q
68FVIDX(VAL,IEN,FROM) ; return index of item beginning with FROM
69 N I,X
70 S VAL=0
71 S X=$O(^ORD(101.44,IEN,20,"C",FROM))
72 I '$L(X) Q
73 S I=$O(^ORD(101.44,IEN,20,"C",X,0))
74 Q:'I
75 S VAL=+I_U_X
76 Q
77FVBLDQ(DGNM,ATTEMPT) ; queue rebuild of set
78 N ZTRTN,ZTIO,ZTDTH,ZTSAVE,ZTDESC,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC,ZTSK
79 N UPDTIME S UPDTIME=$G(^ORD(101.43,"AH","S."_DGNM))
80 I '$G(UPDTIME) S UPDTIME=$H,^ORD(101.43,"AH","S."_DGNM)=UPDTIME
81 S ATTEMPT=$G(ATTEMPT)+1
82 S ZTRTN="FVBLD^ORWUL",ZTIO="",ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,2)
83 S ZTSAVE("ATTEMPT")="",ZTSAVE("UPDTIME")="",ZTSAVE("DGNM")=""
84 S ZTDESC="Rebuild quick view for "_DGNM
85 D ^%ZTLOAD
86 S ^XTMP("ORWDSET "_DGNM,0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_U_$$NOW^XLFDT
87 S ^XTMP("ORWDSET "_DGNM,"TASK")=ZTSK
88 Q
89FVBLD ; rebuild an ORWSET entry
90 ; ATTEMPT, UPDTIME, DGNM expected in environment
91 I $D(ZTQUEUED) S ZTREQ="@"
92 I $D(ZTQUEUED),(ATTEMPT<20),(UPDTIME'=$G(^ORD(101.43,"AH","S."_DGNM))) D FVBLDQ(DGNM,ATTEMPT) Q
93 ; -- create new entry in 101.44 for the set
94 N FDA,FDAIEN,LVW,ADDL
95 S FDA(101.44,"+1,",.01)="ORWDNEW "_DGNM
96 S FDA(101.44,"+1,",6)=UPDTIME
97 D UPDATE^DIE("","FDA","FDAIEN")
98 S LVW=+FDAIEN(1) I 'LVW G FVBLDX
99 ; -- copy all the active items into the list multiple
100 N ASET,SEQ,NM,OI,INACT,CURTM,NMLST,X,Y
101 S ASET="S."_DGNM,SEQ=0,CURTM=$$NOW^XLFDT
102 K ^ORD(101.44,LVW,20)
103 S ^ORD(101.44,LVW,20,0)="^101.442PA"
104 S NM="" F S NM=$O(^ORD(101.43,ASET,NM)) Q:NM="" D
105 . K NMLST
106 . S OI=0 F S OI=$O(^ORD(101.43,ASET,NM,OI)) Q:'OI D
107 . . S X=^ORD(101.43,ASET,NM,OI),INACT=$P(X,U,3)
108 . . Q:$P(X,U,5) I INACT,CURTM>INACT Q
109 . . I 'X S ADDL=""
110 . . E S ADDL=" <"_$P(X,U,4)_">"
111 . . I $P($G(^ORD(101.43,OI,"PS")),U,6) S ADDL=ADDL_" NF"
112 . . S NMLST($P(X,U,2)_ADDL,OI)=""
113 . I '$D(NMLST) Q
114 . S X="" F S X=$O(NMLST(X)) Q:X="" D
115 . . S Y=0 F S Y=$O(NMLST(X,Y)) Q:'Y D
116 . . . S SEQ=SEQ+1
117 . . . S ^ORD(101.44,LVW,20,SEQ,0)=Y_U_X
118 . . . S ^ORD(101.44,LVW,20,"C",$$UP^XLFSTR(X),SEQ)=""
119 S ^ORD(101.44,LVW,20,0)="^101.442PA^"_SEQ_U_SEQ
120 ; -- switch the names of the entries (SET->OLD, NEW->SET)
121 L +^ORD(101.44,"ORWDSET "_DGNM):60
122 S IEN=$O(^ORD(101.44,"B","ORWDSET "_DGNM,0))
123 I IEN K FDA S FDA(101.44,IEN_",",.01)="ORWDOLD "_$H
124 D FILE^DIE("","FDA")
125 K FDA S FDA(101.44,LVW_",",.01)="ORWDSET "_DGNM
126 D FILE^DIE("","FDA")
127 L -^ORD(101.44,"ORWDSET "_DGNM)
128FVBLDX ; -- clean up ^XTMP node
129 K ^XTMP("ORWDSET "_DGNM)
130 D FVCLN
131 Q
132FVCLN ; clean up old set-type entries in the 101.44
133 N LNM,DIK,DA
134 S LNM="ORWDOLD",DIK="^ORD(101.44,"
135 F S LNM=$O(^ORD(101.44,"B",LNM)) Q:$E(LNM,1,7)'="ORWDOLD" D
136 . I ($H-$P(LNM," ",2))<2 Q ; wait until entry is 2 days old
137 . S DA=0 F S DA=$O(^ORD(101.44,"B",LNM,DA)) Q:'DA D ^DIK
138 Q
139QVSAVE(LVW,X,QLST) ; Save a quick order list
140 ; X: Name of List
141 ; QLST: Ptr101.41^DisplayName
142 N DIC,DA,DLAYGO,Y,LVW,SEQ,I
143 S DIC="^ORD(101.44,",DIC(0)="L",DLAYGO=101.44,LVW=0
144 D ^DIC Q:'Y
145 S LVW=+Y,SEQ=0
146 I $D(^ORD(101.44,LVW,10)) D ; KILL "C" XREF
147 . N IDX,QOIEN S IDX=0
148 . F S IDX=$O(^ORD(101.44,LVW,10,IDX)) Q:'IDX D
149 . . S QOIEN=$P(^ORD(101.44,LVW,10,IDX,0),U)
150 . . K ^ORD(101.44,"C",QOIEN,LVW,IDX)
151 K ^ORD(101.44,LVW,10)
152 S ^ORD(101.44,LVW,10,0)="^101.441PA"
153 S I=0 F S I=$O(QLST(I)) Q:'I D
154 . S SEQ=SEQ+1,^ORD(101.44,LVW,10,SEQ,0)=QLST(I)
155 . S ^ORD(101.44,LVW,10,"C",$$UP^XLFSTR($P(QLST(I),U,2)),SEQ)=""
156 . S ^ORD(101.44,"C",+QLST(I),LVW,SEQ)=""
157 S ^ORD(101.44,LVW,10,0)="^101.441PA^"_SEQ_U_SEQ
158 Q
159MVRX ; move pharmacy quick orders into 101.44
160 D MVQO("O RX")
161 D MVQO("UD RX")
162 Q
163MVALL ; move all quick order lists into 101.44
164 Q:$E($O(^ORD(101.44,"B","ORWDQ")),1,5)="ORWDQ"
165 N SNM
166 D BMES^XPDUTL("Moving personal quick orders into 101.44")
167 F SNM="ANI","CARD","CSLT","CT","DO","IV RX","LAB","MAM","MRI","NM","O RX","PROC","RAD","TF","UD RX","US","VAS","XRAY" D
168 . D MES^XPDUTL("-- moving: "_SNM)
169 . D MVQO(SNM)
170 Q
171MVQO(DGNM) ; move quick orders
172 N ENT,PAR,ORTLST,QLST,DLG,X,X0,I,NOP,DNM
173 S PAR=$O(^XTV(8989.51,"B","ORWDQ "_DGNM,0))
174 S ENT="" F S ENT=$O(^XTV(8989.5,"AC",PAR,ENT)) Q:'ENT D
175 . K ORTLST,QLST D GETLST^XPAR(.ORTLST,ENT,PAR,"I")
176 . S I=0 F S I=$O(ORTLST(I)) Q:'I D
177 . . S DLG=+ORTLST(I) Q:'DLG
178 . . S X0=$G(^ORD(101.41,DLG,0)) Q:'$L(X0)
179 . . S DNM=$$GET^XPAR(ENT,"ORWDQ DISPLAY NAME",DLG,"I")
180 . . I '$L(DNM) S DNM=$P(^ORD(101.41,DLG,0),U,2)
181 . . S QLST(I)=DLG_U_DNM
182 . S X=$O(^XTV(8989.51,PAR,30,"AG",$P(ENT,";",2),0))
183 . S X=$P(^XTV(8989.51,PAR,30,X,0),U,2)
184 . S X=$P(^XTV(8989.518,X,0),U,2)
185 . S X="ORWDQ "_X_$P(ENT,";")_" "_DGNM
186 . D QVSAVE(.NOP,X,.QLST)
187 . D EN^XPAR(ENT,"ORWDQ QUICK VIEW",DGNM,X)
188 . ; D NDEL^XPAR(ENT,PAR) ; -- add later, after sure about conversion
189 Q
190ZCLEAN ; cleanup ORWDQ entries in Quick View file
191 N ANAM,ANIEN,DIK,DA
192 S ANAM="ORWDQ",DIK="^ORD(101.44,"
193 F S ANAM=$O(^ORD(101.44,"B",ANAM)) Q:$E(ANAM,1,5)'="ORWDQ" D
194 . W !,"deleting "_ANAM
195 . S ANIEN=$O(^ORD(101.44,"B",ANAM,0))
196 . S DA=ANIEN D ^DIK
197 W !,"rebuilding entries"
198 D MVALL
199 Q
Note: See TracBrowser for help on using the repository browser.