source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCMEDT7.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 7.4 KB
Line 
1ORCMEDT7 ;SLC/JM-QO,Edit Quick Orders By User ;2/1/06
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**245**;Dec 17, 1997;Build 2
3 Q
4QCKBYUSR ; Edit quick orders by user
5 N ORDGINFO,ORTEXT,ORIEN,ORFMDATA,ORUSER,ORDG,ORLINE0
6 K ^TMP("ORWDQUSR",$J)
7 S ORUSER=0
8 F S ORDGINFO=$$QCKUSRDG(ORUSER) Q:ORDGINFO=0 S:ORDGINFO<0 ORUSER=0 I +ORDGINFO>0,$D(^ORD(101.41,+ORDGINFO,0)) D
9 . S ORIEN=$P(ORDGINFO,U,1)
10 . S ORFMDATA=$P(ORDGINFO,U,2)
11 . S ORUSER=$P(ORDGINFO,U,3)
12 . S ORLINE0=$G(^ORD(101.41,ORIEN,0))
13 . S ORTEXT=$P(ORLINE0,U,2)
14 . S ORDG=+$P(ORLINE0,U,5)
15 . D QCK0^ORCMEDT1(ORIEN) ; edit quick order
16 . D VERIFYDA(.ORFMDATA,ORIEN)
17 . I +ORFMDATA D
18 . . ; If quick order not deleted, and display text changes, change 101.44 display text to match
19 . . I $D(^ORD(101.41,ORIEN,0)),ORTEXT'=$P(^ORD(101.41,ORIEN,0),U,2) D
20 . . . N DIE,DA,DR,DIDEL
21 . . . S DA(1)=$P(ORFMDATA,";",1)
22 . . . S DIE="^ORD(101.44,"_DA(1)_",10,"
23 . . . S DA=$P(ORFMDATA,";",2)
24 . . . ; 101.44 Display text holds 132 chars, 101.41 only 80. so this is ok
25 . . . S DR="2///"_$P(^ORD(101.41,ORIEN,0),U,2)
26 . . . D ^DIE
27 . K ^TMP("ORWDQUSR",$J,"A",ORUSER) ; Force reload of user Quick Order info
28 . W !
29 K ^TMP("ORWDQUSR",$J)
30 Q
31QCKUSRDG(ORLSTUSR) ; Get quick order dialog by user
32 N DIC,DIR,DA,X,Y,ORIDX,ORUSER,ORLEN,ORPRE,ORDIALOG,ORHEADER,ORGROUP,ORCOUNT,USERNAME
33 N DTOUT,DUOUT,DIROUT,DIRUT,OREXIT,ORINPUT,ORDGNAME,ORDGIEN,ORLASTGP,ORFMDATA,ORFIRST
34 S ORDIALOG=0
35 S ORUSER=$$GETUSER(ORLSTUSR)
36 I ORUSER>0 D
37 . S ORPRE="ORWDQ USR"_ORUSER,ORLEN=$L(ORPRE)
38 . S ORIDX=$O(^ORD(101.44,"B",ORPRE))
39 . I $E(ORIDX,1,ORLEN)=ORPRE D I 1
40 . . D QULIST(ORUSER)
41 . . S USERNAME=$P($G(^VA(200,ORUSER,0)),U,1)
42 . . S ORHEADER=USERNAME_" personal quick orders:"
43 . . S ORCOUNT=0,ORIDX=0,OREXIT=0,ORLASTGP=U,ORFIRST=1
44 . . F S ORIDX=$O(^TMP("ORWDQUSR",$J,"A",ORUSER,ORIDX)) Q:'+ORIDX D Q:+OREXIT!(ORDIALOG>0)
45 . . . S ORCOUNT=ORCOUNT+1
46 . . . I ORCOUNT=1 D
47 . . . . I ORFIRST S ORFIRST=0 W !,!
48 . . . . W !,ORHEADER,!
49 . . . S ORGROUP=$O(^TMP("ORWDQUSR",$J,"A",ORUSER,ORIDX,""))
50 . . . S ORDGIEN=$O(^TMP("ORWDQUSR",$J,"A",ORUSER,ORIDX,ORGROUP,""))
51 . . . S ORFMDATA=$O(^TMP("ORWDQUSR",$J,"A",ORUSER,ORIDX,ORGROUP,ORDGIEN,""))
52 . . . S ORDGNAME=$G(^TMP("ORWDQUSR",$J,"A",ORUSER,ORIDX,ORGROUP,ORDGIEN,ORFMDATA))
53 . . . I (ORCOUNT=1)!(ORGROUP'=ORLASTGP) D
54 . . . . S ORLASTGP=ORGROUP
55 . . . . S ORCOUNT=ORCOUNT+1
56 . . . . W ?4,ORGROUP,!
57 . . . W ?7,ORIDX,?12,ORDGNAME,!
58 . . . I ORCOUNT'<18 D
59 . . . . S DIR("A",1)="Press <RETURN> to see more, '^' to exit this list, OR"
60 . . . . S ORDIALOG=$$QUIDX()
61 . . . . S ORCOUNT=0
62 . . I ORDIALOG'>0,'+OREXIT D
63 . . . S ORIDX=$O(^TMP("ORWDQUSR",$J,"A",ORUSER,999999),-1)
64 . . . I ORIDX<1 D I 1
65 . . . . ; If user had quick orders, but doesn't any more, there will be false positives in "B" xref
66 . . . . D QULIST(0)
67 . . . . K ^TMP("ORWDQUSR",$J,"B",USERNAME)
68 . . . . D SHOWUSRS
69 . . . E D
70 . . . . S DIR("A",1)=""
71 . . . . S ORDIALOG=$$QUIDX()
72 . E D SHOWUSRS
73 Q ORDIALOG
74GETUSER(ORUSER) ;
75 I +ORUSER Q ORUSER
76 N DIC,Y,X,DLAYGO,DINUM
77 S DIC="^VA(200,",DIC(0)="AEMQ"
78 D ^DIC
79 Q +Y
80SHOWUSRS ;
81 S ORDIALOG=-1 ; Repeats loop
82 W !,!,$P($G(^VA(200,ORUSER,0)),U,1)_" does not have any personal quick orders."
83 S DIR("A")="Would you like to see a list of users with personal quick orders"
84 S DIR(0)="Y",DIR("B")="YES"
85 D ^DIR
86 I +Y D I 1
87 . W !,!," Choose from:",!
88 . D QULIST(0)
89 . S ORUSER="",ORIDX=2,OREXIT=0
90 . F S ORUSER=$O(^TMP("ORWDQUSR",$J,"B",ORUSER)) Q:OREXIT!(ORUSER="") D Q:OREXIT
91 . . W " ",ORUSER,!
92 . . S ORIDX=ORIDX+1
93 . . I ORIDX=22 D
94 . . . S ORIDX=0
95 . . . R " '^' TO STOP: ",ORINPUT:$G(DTIME,300)
96 . . . E S OREXIT=1
97 . . . W $C(13),$J("",20),$C(13) Q:OREXIT
98 . . . I ORINPUT[U S OREXIT=1
99 E I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) S ORDIALOG=0
100 Q
101QUIDX() ; Get quick order dialog info
102 N ORGROUP,ORDGIEN,ORFMDATA,ORRESULT
103 S DIR("A")="CHOOSE 1-"_ORIDX_": "
104 S DIR(0)="NOA^1:"_ORIDX
105 D ^DIR
106 I +Y>0,+Y'>ORIDX D Q ORRESULT
107 . S ORGROUP=$O(^TMP("ORWDQUSR",$J,"A",ORUSER,+Y,""))
108 . S ORDGIEN=$O(^TMP("ORWDQUSR",$J,"A",ORUSER,+Y,ORGROUP,""))
109 . I $$CONFLICT(ORUSER,ORDGIEN) S OREXIT=1,ORRESULT=-1 Q
110 . S ORFMDATA=$O(^TMP("ORWDQUSR",$J,"A",ORUSER,+Y,ORGROUP,ORDGIEN,""))
111 . S ORRESULT=ORDGIEN_U_ORFMDATA_U_ORUSER
112 W !
113 I Y[U S OREXIT=1
114 Q -1 ; -1 Value repeats the enter name loop / 0 exits loop
115QULIST(ORUSER) ; Build user info
116 N PRE,ID,LEN
117 S PRE="ORWDQ USR"
118 I ORUSER=0 D Q
119 . ; "B" node is list of all users with Quick Orders
120 . I $D(^TMP("ORWDQUSR",$J,"B")) Q
121 . N LASTUSER,USERNAME,USER
122 . S LASTUSER=0,ID=PRE,LEN=$L(PRE)
123 . F S ID=$O(^ORD(101.44,"B",ID)) Q:($E(ID,1,LEN)'=PRE) D
124 . . S USER=$P($E(ID,LEN+1,999)," ")
125 . . I USER'=LASTUSER D
126 . . . S LASTUSER=USER
127 . . . S USERNAME=$P($G(^VA(200,USER,0)),U,1)
128 . . . S ^TMP("ORWDQUSR",$J,"B",USERNAME)=""
129 . Q
130 ;
131 ; "A" node is list of quick orders for an individual user
132 ; Temp array nodes are "ORWDQUSR",$J,"A"
133 ; User IEN, Index Number, Display Group, Quick Order IEN, 101.44 IEN
134 ; Data value is Quick Order Name - (Name can be 132 chars so can't be node)
135 ;
136 I $D(^TMP("ORWDQUSR",$J,"A",ORUSER)) Q
137 N GROUP,IDX,NUMBER,QOINDEX,QCKORDER,ORFMDATA
138 S PRE=PRE_ORUSER,ID=PRE,NUMBER=0,LEN=$L(PRE)
139 F S ID=$O(^ORD(101.44,"B",ID)) Q:($E(ID,1,LEN)'=PRE) D
140 . S GROUP=$P(ID," ",3,999)
141 . S GROUP=$O(^ORD(100.98,"B",GROUP,0))
142 . I +GROUP S GROUP=$P($G(^ORD(100.98,GROUP,0)),U,1)
143 . S IDX=$O(^ORD(101.44,"B",ID,0)),QOINDEX=0
144 . F S QOINDEX=$O(^ORD(101.44,IDX,10,QOINDEX)) Q:'+QOINDEX D
145 . . S QCKORDER=$G(^ORD(101.44,IDX,10,QOINDEX,0))
146 . . I +QCKORDER,+$D(^ORD(101.41,+QCKORDER)) D
147 . . . S NUMBER=NUMBER+1
148 . . . S ORFMDATA=IDX_";"_QOINDEX
149 . . . S ^TMP("ORWDQUSR",$J,"A",ORUSER,NUMBER,GROUP,$P(QCKORDER,U,1),ORFMDATA)=$P(QCKORDER,U,2)
150 Q
151VERIFYDA(ORFMDATA,ORIEN) ;
152 ; Make sure FileMan pointers are still correct
153 ; - may have changes via CPRS GUI or QCK0^ORCMEDT1(ORIEN)
154 N IDX1,IDX2,IEN
155 S IDX1=$P(ORFMDATA,";",1)
156 S IDX2=$P(ORFMDATA,";",2)
157 S IEN=$P($G(^ORD(101.44,IDX1,10,IDX2,0)),U,1)
158 I IEN=ORIEN Q
159 S ORFMDATA=""
160 S IDX2=0
161 F S IDX2=$O(^ORD(101.44,IDX1,10,IDX2)) Q:'+IDX2 D Q:+ORFMDATA
162 . I $P($G(^ORD(101.44,IDX1,10,IDX2,0)),U,1)=ORIEN S ORFMDATA=IDX1_";"_IDX2
163 Q
164CONFLICT(ORUSER,DIALOG) ; Determine if another user shares the personal quick order
165 N DG,OTHERS,USR,NAME,ABORT,DIR,Y,DA,X,DTOUT,DUOUT,DIROUT,DIRUT,COUNT,TEMP
166 S (DG,ABORT)=0
167 F S DG=$O(^ORD(101.44,"C",DIALOG,DG)) Q:'+DG D
168 . S USR=$P($G(^ORD(101.44,DG,0)),U,1)
169 . I $P(USR," ",1)="ORWDQ" D
170 . . S USR=$P(USR," ",2)
171 . . I $E(USR,1,3)="USR" D
172 . . . S USR=$E(USR,4,999)
173 . . . I USR'=ORUSER D
174 . . . . S NAME=$P($G(^VA(200,USR,0)),U,1)
175 . . . . S OTHERS(NAME)=""
176 I $D(OTHERS) D
177 . S OTHERS($P($G(^VA(200,ORUSER,0)),U,1))=""
178 . W !,$C(7),!,!
179 . W " *********************",!
180 . W " ***** WARNING *****",!
181 . W " *********************",!,!
182 . W " Multiple users share this personal quick order.",!
183 . W " Modifying this personal quick order will change",!
184 . W " it for all of the following users:",!,!
185 . S NAME="",COUNT=7
186 . F S NAME=$O(OTHERS(NAME)) Q:NAME="" D Q:ABORT
187 . . S COUNT=COUNT+1
188 . . I COUNT>20 D Q:ABORT
189 . . . S COUNT=0,TEMP=""
190 . . . W !
191 . . . R " Press <RETURN> to continue, '^' to exit: ",TEMP:$G(DTIME,300)
192 . . . E S ABORT=1
193 . . . W $C(13),$J("",50),$C(13) Q:ABORT
194 . . . I (TEMP[U)!$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) S ABORT=1
195 . . W " ",NAME,!
196 . I 'ABORT D
197 . . S DIR("A")="Are you sure you want to edit this personal quick order? "
198 . . S DIR(0)="YA",DIR("B")="NO" W ! D ^DIR
199 . . W !
200 . . I '+Y S ABORT=1
201 Q ABORT
Note: See TracBrowser for help on using the repository browser.