- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWTPR.m
r613 r623 1 ORWTPR ; SLC/STAFF Personal Preference - Reminders ; 4/20/07 10:00am 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,173,215,243**;Oct 24, 2000;Build 242 3 ; 4 GETREM(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 ; 18 SETREM(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 ; 27 GETOC(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 ; 40 SAVEOC(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 ; 49 GETNOT(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 ; 60 SAVENOT(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 ; 68 CLEARNOT(OK,USER) ; from ORWTPP 69 ; clear user's notifications 70 D RECIPURG^XQALBUTL(USER) 71 S OK=1 72 Q 73 ; 74 GETNOTO(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 ; 80 GETSURR(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 ; 87 SAVESURR(OK,INFO,USER) ; from ORWTPP 88 ; save user's surrogate info 89 N START,STOP,SURR,RET 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 S RET=$$SAVESURR^ORWTPUA(USER,SURR,START,STOP) 95 I 'RET S OK="0^"_RET 96 Q 97 ; 98 SAVENOTO(OK,INFO,USER) ; from ORWTPP 99 ; save user's notification settings 100 N ERR,FLAG,VAL 101 S OK=1 102 S FLAG=$P(INFO,U,3) 103 S VAL=$S(FLAG>0:"Y",1:"@") 104 D EN^XPAR(USER_";VA(200,","ORB FLAGGED ORDERS BULLETIN",1,VAL,.ERR) 105 Q 106 ; 107 OCDESC(TEXT,IEN) ; from RPC 108 N CNT,LINE,NUM K TEXT 109 S IEN=+$G(IEN) I IEN<1 Q 110 S TEXT(1)=$P($G(^ORD(100.8,IEN,0)),U) 111 S TEXT(2)="" 112 S CNT=2 113 S NUM=0 F S NUM=$O(^ORD(100.8,IEN,1,NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) D 114 .S CNT=CNT+1 115 .S TEXT(CNT)=LINE 116 S TEXT(CNT+1)="" 117 Q 118 ; 119 NOTDESC(TEXT,IEN) ; from RPC 120 K TEXT 121 S IEN=+$G(IEN) I IEN<1 Q 122 S TEXT(1)=$P($G(^ORD(100.9,IEN,0)),U) 123 S TEXT(2)="" 124 S TEXT(3)=$P($G(^ORD(100.9,IEN,4)),U) 125 S TEXT(4)="" 126 Q 1 ORWTPR ; SLC/STAFF Personal Preference - Reminders ;5/3/01 15:32 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,173,215**;Oct 24, 2000 3 ; 4 GETREM(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 ; 18 SETREM(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 ; 27 GETOC(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 ; 40 SAVEOC(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 ; 49 GETNOT(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 ; 60 SAVENOT(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 ; 68 CLEARNOT(OK,USER) ; from ORWTPP 69 ; clear user's notifications 70 D RECIPURG^XQALBUTL(USER) 71 S OK=1 72 Q 73 ; 74 GETNOTO(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 ; 80 GETSURR(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 ; 87 SAVESURR(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 ; 97 SAVENOTO(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 ; 106 OCDESC(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 ; 118 NOTDESC(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 TracChangeset
for help on using the changeset viewer.
