source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWTPR.m@ 1450

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

revised back to 6/30/08 version
File size: 3.7 KB
RevLine 
[623]1ORWTPR ; SLC/STAFF Personal Preference - Reminders ;5/3/01 15:32
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,173,215**;Oct 24, 2000
3 ;
4GETREM(VALUES,USER) ; from ORWTPP
5 ; get user's reminders
6 N CLASS,CNT,ERR,IEN,NUM,OK,TMPLIST,ZERO K VALUES
7 D GETLST^XPAR(.TMPLIST,"USR.`"_USER,"ORQQPX SEARCH ITEMS","Q",.ERR)
8 S CNT=0,IEN=0 F S IEN=$O(^PXD(811.9,IEN)) Q:IEN<1 S ZERO=$G(^(IEN,0)) I $L($P(ZERO,U,3)),'$P(ZERO,U,6) D
9 .S CNT=CNT+1
10 .S VALUES(CNT)=IEN_"^0^"_$P(ZERO,U,3)_U_$P(ZERO,U)
11 .S CLASS=$P($G(^PXD(811.9,IEN,100)),U)
12 .S $P(VALUES(CNT),U,5)=$S(CLASS="N":"NATIONAL",CLASS="L":"LOCAL",1:CLASS)
13 .S OK=0,NUM=0 F S NUM=$O(TMPLIST(NUM)) Q:NUM<1 D Q:OK
14 ..I IEN=$P(TMPLIST(NUM),U,2) S OK=1
15 .I OK S $P(VALUES(CNT),U,2)=$P(TMPLIST(NUM),U)
16 Q
17 ;
18SETREM(OK,VALUES,USER) ; from ORWTPP
19 ; save user's reminders
20 N NUM,ERR
21 S OK=1
22 D NDEL^XPAR("USR.`"_USER,"ORQQPX SEARCH ITEMS",.ERR)
23 S NUM=0 F S NUM=$O(VALUES(NUM)) Q:NUM<1 D
24 .D EN^XPAR(USER_";VA(200,","ORQQPX SEARCH ITEMS",$P(VALUES(NUM),U,1),"`"_$P(VALUES(NUM),U,2),.ERR)
25 Q
26 ;
27GETOC(VALUES,USER) ; from ORWTPP
28 ; get user's order checks
29 N CNT,IEN,LIST,NUM,VAL,VALOK K LIST,VALUES
30 S IEN=0 F S IEN=$O(^ORD(100.8,IEN)) Q:IEN<1 D
31 .S VAL=$$GET^XPAR("ALL","ORK PROCESSING FLAG",IEN,"I")
32 .I '$L(VAL) Q
33 .S VALOK=$$GET^XPAR("ALL","ORK EDITABLE BY USER",IEN,"I")
34 .S LIST(IEN)=VAL_U_VALOK
35 S NUM=0,CNT=0 F S NUM=$O(LIST(NUM)) Q:NUM<1 D
36 .S CNT=CNT+1
37 .S VALUES(CNT)=NUM_U_$P($G(^ORD(100.8,NUM,0)),U)_U_$S($P(LIST(NUM),U)="E":"ON",1:"OFF")_U_$S($P(LIST(NUM),U,2)="0":"MANDATORY",1:"")
38 Q
39 ;
40SAVEOC(OK,VALUES,USER) ; from ORWTPP
41 ; save user's order checks
42 N NUM,ERR
43 S OK=1
44 S NUM=0 F S NUM=$O(VALUES(NUM)) Q:NUM<1 D
45 .D EN^XPAR(USER_";VA(200,","ORK PROCESSING FLAG","`"_+VALUES(NUM),$S($P(VALUES(NUM),U,2)="ON":"E",1:"D"),.ERR)
46 Q
47 ;
48 ;
49GETNOT(VALUES,USER) ; from ORWTPP
50 ; get user's notifications
51 N CNT,IEN,NAME,RESULT K VALUES
52 S CNT=0
53 S NAME="" F S NAME=$O(^ORD(100.9,"B",NAME)) Q:NAME="" D
54 .S IEN=0 F S IEN=$O(^ORD(100.9,"B",NAME,IEN)) Q:IEN<1 D
55 ..S RESULT=$$ONOFF^ORB3USER(IEN,USER,"","") I $L($G(RESULT)) D
56 ...S CNT=CNT+1
57 ...S VALUES(CNT)=IEN_U_NAME_U_$P(RESULT,U)_U_$S($$UP^XLFSTR($P(RESULT,U,3))["MANDATORY":"MANDATORY",1:"")
58 Q
59 ;
60SAVENOT(OK,VALUES,USER) ; from ORWTPP
61 ; save user's notifications
62 N ERR,NUM
63 S OK=1
64 S NUM=0 F S NUM=$O(VALUES(NUM)) Q:NUM<1 D
65 .D EN^XPAR(USER_";VA(200,","ORB PROCESSING FLAG","`"_+VALUES(NUM),$S($P(VALUES(NUM),U,2)="ON":"E",1:"D"),.ERR)
66 Q
67 ;
68CLEARNOT(OK,USER) ; from ORWTPP
69 ; clear user's notifications
70 D RECIPURG^XQALBUTL(USER)
71 S OK=1
72 Q
73 ;
74GETNOTO(INFO,USER) ; from ORWTPP
75 ; get user's other info for notifications
76 I $$GET^XPAR("USR.`"_USER,"ORB FLAGGED ORDERS BULLETIN",1,"Q")="Y" S $P(INFO,U,2)=1
77 I $$GET^XPAR("ALL^USR.`"_USER,"ORB ERASE ALL",1,"Q") S $P(INFO,U,3)=1
78 Q
79 ;
80GETSURR(INFO,USER) ; from ORWTPP
81 ; get user's surrogate info
82 N SURR
83 D SUROLIST^XQALSURO(USER,.SURR)
84 S INFO=$G(SURR(1))
85 Q
86 ;
87SAVESURR(OK,INFO,USER) ; from ORWTPP
88 ; save user's surrogate info
89 N START,STOP,SURR
90 S OK=1
91 S SURR=$P(INFO,U,1)
92 S START=$P(INFO,U,2)
93 S STOP=$P(INFO,U,3)
94 D SAVESURR^ORWTPUA(USER,SURR,START,STOP)
95 Q
96 ;
97SAVENOTO(OK,INFO,USER) ; from ORWTPP
98 ; save user's notification settings
99 N ERR,FLAG,VAL
100 S OK=1
101 S FLAG=$P(INFO,U,3)
102 S VAL=$S(FLAG>0:"Y",1:"@")
103 D EN^XPAR(USER_";VA(200,","ORB FLAGGED ORDERS BULLETIN",1,VAL,.ERR)
104 Q
105 ;
106OCDESC(TEXT,IEN) ; from RPC
107 N CNT,LINE,NUM K TEXT
108 S IEN=+$G(IEN) I IEN<1 Q
109 S TEXT(1)=$P($G(^ORD(100.8,IEN,0)),U)
110 S TEXT(2)=""
111 S CNT=2
112 S NUM=0 F S NUM=$O(^ORD(100.8,IEN,1,NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) D
113 .S CNT=CNT+1
114 .S TEXT(CNT)=LINE
115 S TEXT(CNT+1)=""
116 Q
117 ;
118NOTDESC(TEXT,IEN) ; from RPC
119 K TEXT
120 S IEN=+$G(IEN) I IEN<1 Q
121 S TEXT(1)=$P($G(^ORD(100.9,IEN,0)),U)
122 S TEXT(2)=""
123 S TEXT(3)=$P($G(^ORD(100.9,IEN,4)),U)
124 S TEXT(4)=""
125 Q
Note: See TracBrowser for help on using the repository browser.