Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORWTPR

ORWTPR.m

Go to the documentation of this file. 
  1. ORWTPR ; SLC/STAFF Personal Preference - Reminders ; 4/20/07 10:00am
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,173,215,243**;Oct 24, 2000;Build 242
  1.  ;
  1. GETREM(VALUES,USER) ; from ORWTPP
  1.  ; get user's reminders
  1.  N CLASS,CNT,ERR,IEN,NUM,OK,TMPLIST,ZERO K VALUES
  1.  D GETLST^XPAR(.TMPLIST,"USR.`"_USER,"ORQQPX SEARCH ITEMS","Q",.ERR)
  1.  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
  1.  .S CNT=CNT+1
  1.  .S VALUES(CNT)=IEN_"^0^"_$P(ZERO,U,3)_U_$P(ZERO,U)
  1.  .S CLASS=$P($G(^PXD(811.9,IEN,100)),U)
  1.  .S $P(VALUES(CNT),U,5)=$S(CLASS="N":"NATIONAL",CLASS="L":"LOCAL",1:CLASS)
  1.  .S OK=0,NUM=0 F  S NUM=$O(TMPLIST(NUM)) Q:NUM<1  D  Q:OK
  1.  ..I IEN=$P(TMPLIST(NUM),U,2) S OK=1
  1.  .I OK S $P(VALUES(CNT),U,2)=$P(TMPLIST(NUM),U)
  1.  Q
  1.  ;
  1. SETREM(OK,VALUES,USER) ; from ORWTPP
  1.  ; save user's reminders
  1.  N NUM,ERR
  1.  S OK=1
  1.  D NDEL^XPAR("USR.`"_USER,"ORQQPX SEARCH ITEMS",.ERR)
  1.  S NUM=0 F  S NUM=$O(VALUES(NUM)) Q:NUM<1  D
  1.  .D EN^XPAR(USER_";VA(200,","ORQQPX SEARCH ITEMS",$P(VALUES(NUM),U,1),"`"_$P(VALUES(NUM),U,2),.ERR)
  1.  Q
  1.  ;
  1. GETOC(VALUES,USER) ; from ORWTPP
  1.  ; get user's order checks
  1.  N CNT,IEN,LIST,NUM,VAL,VALOK K LIST,VALUES
  1.  S IEN=0 F  S IEN=$O(^ORD(100.8,IEN)) Q:IEN<1  D
  1.  .S VAL=$$GET^XPAR("ALL","ORK PROCESSING FLAG",IEN,"I")
  1.  .I '$L(VAL) Q
  1.  .S VALOK=$$GET^XPAR("ALL","ORK EDITABLE BY USER",IEN,"I")
  1.  .S LIST(IEN)=VAL_U_VALOK
  1.  S NUM=0,CNT=0 F  S NUM=$O(LIST(NUM)) Q:NUM<1  D
  1.  .S CNT=CNT+1
  1.  .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:"")
  1.  Q
  1.  ;
  1. SAVEOC(OK,VALUES,USER) ; from ORWTPP
  1.  ; save user's order checks
  1.  N NUM,ERR
  1.  S OK=1
  1.  S NUM=0 F  S NUM=$O(VALUES(NUM)) Q:NUM<1  D
  1.  .D EN^XPAR(USER_";VA(200,","ORK PROCESSING FLAG","`"_+VALUES(NUM),$S($P(VALUES(NUM),U,2)="ON":"E",1:"D"),.ERR)
  1.  Q
  1.  ;
  1.  ;
  1. GETNOT(VALUES,USER) ; from ORWTPP
  1.  ; get user's notifications
  1.  N CNT,IEN,NAME,RESULT K VALUES
  1.  S CNT=0
  1.  S NAME="" F  S NAME=$O(^ORD(100.9,"B",NAME)) Q:NAME=""  D
  1.  .S IEN=0  F  S IEN=$O(^ORD(100.9,"B",NAME,IEN)) Q:IEN<1  D
  1.  ..S RESULT=$$ONOFF^ORB3USER(IEN,USER,"","") I $L($G(RESULT)) D
  1.  ...S CNT=CNT+1
  1.  ...S VALUES(CNT)=IEN_U_NAME_U_$P(RESULT,U)_U_$S($$UP^XLFSTR($P(RESULT,U,3))["MANDATORY":"MANDATORY",1:"")
  1.  Q
  1.  ;
  1. SAVENOT(OK,VALUES,USER) ; from ORWTPP
  1.  ; save user's notifications
  1.  N ERR,NUM
  1.  S OK=1
  1.  S NUM=0 F  S NUM=$O(VALUES(NUM)) Q:NUM<1  D
  1.  .D EN^XPAR(USER_";VA(200,","ORB PROCESSING FLAG","`"_+VALUES(NUM),$S($P(VALUES(NUM),U,2)="ON":"E",1:"D"),.ERR)
  1.  Q
  1.  ;
  1. CLEARNOT(OK,USER) ; from ORWTPP
  1.  ; clear user's notifications
  1.  D RECIPURG^XQALBUTL(USER)
  1.  S OK=1
  1.  Q
  1.  ;
  1. GETNOTO(INFO,USER) ; from ORWTPP
  1.  ; get user's other info for notifications
  1.  I $$GET^XPAR("USR.`"_USER,"ORB FLAGGED ORDERS BULLETIN",1,"Q")="Y" S $P(INFO,U,2)=1
  1.  I $$GET^XPAR("ALL^USR.`"_USER,"ORB ERASE ALL",1,"Q") S $P(INFO,U,3)=1
  1.  Q
  1.  ;
  1. GETSURR(INFO,USER) ; from ORWTPP
  1.  ; get user's surrogate info
  1.  N SURR
  1.  D SUROLIST^XQALSURO(USER,.SURR)
  1.  S INFO=$G(SURR(1))
  1.  Q
  1.  ;
  1. SAVESURR(OK,INFO,USER) ; from ORWTPP
  1.  ; save user's surrogate info
  1.  N START,STOP,SURR,RET
  1.  S OK=1
  1.  S SURR=$P(INFO,U,1)
  1.  S START=$P(INFO,U,2)
  1.  S STOP=$P(INFO,U,3)
  1.  S RET=$$SAVESURR^ORWTPUA(USER,SURR,START,STOP)
  1.  I 'RET S OK="0^"_RET
  1.  Q
  1.  ;
  1. SAVENOTO(OK,INFO,USER) ; from ORWTPP
  1.  ; save user's notification settings
  1.  N ERR,FLAG,VAL
  1.  S OK=1
  1.  S FLAG=$P(INFO,U,3)
  1.  S VAL=$S(FLAG>0:"Y",1:"@")
  1.  D EN^XPAR(USER_";VA(200,","ORB FLAGGED ORDERS BULLETIN",1,VAL,.ERR)
  1.  Q
  1.  ;
  1. OCDESC(TEXT,IEN) ; from RPC
  1.  N CNT,LINE,NUM K TEXT
  1.  S IEN=+$G(IEN) I IEN<1 Q
  1.  S TEXT(1)=$P($G(^ORD(100.8,IEN,0)),U)
  1.  S TEXT(2)=""
  1.  S CNT=2
  1.  S NUM=0 F  S NUM=$O(^ORD(100.8,IEN,1,NUM)) Q:NUM<1  S LINE=$G(^(NUM,0)) D
  1.  .S CNT=CNT+1
  1.  .S TEXT(CNT)=LINE
  1.  S TEXT(CNT+1)=""
  1.  Q
  1.  ;
  1. NOTDESC(TEXT,IEN) ; from RPC
  1.  K TEXT
  1.  S IEN=+$G(IEN) I IEN<1 Q
  1.  S TEXT(1)=$P($G(^ORD(100.9,IEN,0)),U)
  1.  S TEXT(2)=""
  1.  S TEXT(3)=$P($G(^ORD(100.9,IEN,4)),U)
  1.  S TEXT(4)=""
  1.  Q