ORWTPR ;SLC/STAFF - Personal Preference, Reminders ;Jun 22, 2021@14:06:23
;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,173,215,243,280,415,458,539,405**;Oct 24, 2000;Build 211
;
GETREM(VALUES,USER) ; from ORWTPP
; get user's reminders
N CLASS,CNT,ERR,IEN,NUM,OK,TMPLIST,ZERO K VALUES
D GETLST^XPAR(.TMPLIST,"USR.`"_USER,"ORQQPX SEARCH ITEMS","Q",.ERR)
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
.S CNT=CNT+1
.S VALUES(CNT)=IEN_"^0^"_$P(ZERO,U,3)_U_$P(ZERO,U)
.S CLASS=$P($G(^PXD(811.9,IEN,100)),U)
.S $P(VALUES(CNT),U,5)=$S(CLASS="N":"NATIONAL",CLASS="L":"LOCAL",1:CLASS)
.S OK=0,NUM=0 F S NUM=$O(TMPLIST(NUM)) Q:NUM<1 D Q:OK
..I IEN=$P(TMPLIST(NUM),U,2) S OK=1
.I OK S $P(VALUES(CNT),U,2)=$P(TMPLIST(NUM),U)
Q
;
SETREM(OK,VALUES,USER) ; from ORWTPP
; save user's reminders
N NUM,ERR
S OK=1
D NDEL^XPAR("USR.`"_USER,"ORQQPX SEARCH ITEMS",.ERR)
S NUM=0 F S NUM=$O(VALUES(NUM)) Q:NUM<1 D
.D EN^XPAR(USER_";VA(200,","ORQQPX SEARCH ITEMS",$P(VALUES(NUM),U,1),"`"_$P(VALUES(NUM),U,2),.ERR)
Q
;
GETOC(VALUES,USER) ; from ORWTPP
; get user's order checks
N CNT,IEN,LIST,NUM,VAL,VALOK K LIST,VALUES
S IEN=0 F S IEN=$O(^ORD(100.8,IEN)) Q:IEN<1 D
.S VAL=$$GET^XPAR("ALL","ORK PROCESSING FLAG",IEN,"I")
.I '$L(VAL) Q
.S VALOK=$$GET^XPAR("ALL","ORK EDITABLE BY USER",IEN,"I")
.S LIST(IEN)=VAL_U_VALOK
S NUM=0,CNT=0 F S NUM=$O(LIST(NUM)) Q:NUM<1 D
.S CNT=CNT+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:"")
Q
;
SAVEOC(OK,VALUES,USER) ; from ORWTPP
; save user's order checks
N NUM,ERR
S OK=1
S NUM=0 F S NUM=$O(VALUES(NUM)) Q:NUM<1 D
.D EN^XPAR(USER_";VA(200,","ORK PROCESSING FLAG","`"_+VALUES(NUM),$S($P(VALUES(NUM),U,2)="ON":"E",1:"D"),.ERR)
Q
;
;
GETNOT(VALUES,USER) ; from ORWTPP
; get user's notifications
N CNT,IEN,NAME,RESULT K VALUES
S CNT=0
S NAME="" F S NAME=$O(^ORD(100.9,"B",NAME)) Q:NAME="" D
.S IEN=0 F S IEN=$O(^ORD(100.9,"B",NAME,IEN)) Q:IEN<1 D
..N ORMNDFLG S ORMNDFLG=0 ;458 added flag to check for mandatory
..S RESULT=$$ONOFF^ORB3USER(IEN,USER,"","") I $L($G(RESULT)) D
...S CNT=CNT+1
...S VALUES(CNT)=IEN_U_NAME_U_$P(RESULT,U)_U_$S(ORMNDFLG:"MANDATORY",1:"")
Q
;
SAVENOT(OK,VALUES,USER) ; from ORWTPP
; save user's notifications
N ERR,NUM
S OK=1
S NUM=0 F S NUM=$O(VALUES(NUM)) Q:NUM<1 D
.D EN^XPAR(USER_";VA(200,","ORB PROCESSING FLAG","`"_+VALUES(NUM),$S($P(VALUES(NUM),U,2)="ON":"E",1:"D"),.ERR)
Q
;
CLEARNOT(OK,USER) ; from ORWTPP
; clear user's notifications
D RECIPURG^XQALBUTL(USER) ;ICR(DBIA) #3010
S OK=1
Q
;
GETNOTO(INFO,USER) ; from ORWTPP
; get user's other info for notifications
I $$GET^XPAR("USR.`"_USER,"ORB FLAGGED ORDERS BULLETIN",1,"Q")="Y" S $P(INFO,U,2)=1
I $$GET^XPAR("ALL^USR.`"_USER,"ORB ERASE ALL",1,"Q") S $P(INFO,U,3)=1
S $P(INFO,U,4)=$$GET^XPAR("USR.`"_USER,"ORB DAYS FOR PROCESSED ALERTS",1,"Q")
S $P(INFO,U,5)=$$GET^XPAR("USR.`"_USER,"ORB MAX PROCESSED ALERTS",1,"Q")
Q
;
GETSURR(INFO,USER) ; from ORWTPP
; get user's surrogate info
N SURR
D SUROLIST^XQALSURO(USER,.SURR) ;ICR(DBIA) #2790
S INFO=$G(SURR(1))
Q
;
GETSURRS(INFO,USER) ; from ORWTPP ;TDP - Added for CPRSv32A (*539) surrogate modifications
; get all user's surrogate info
N DATA,LST,X
K INFO
S INFO=""
D SUROLIST^XQALSURO(USER,.INFO) ;ICR(DBIA) #2790
S LST=0
I +INFO>0 D
. S X=0 F S X=$O(INFO(X)) Q:X="" D
.. S DATA=$G(INFO(X))
.. I $P(DATA,U,3)=$P(DATA,U,4),$P(DATA,U,3)'="",$P(DATA,U,4)'="" Q
.. ;I $P(DATA,U,3)="",$P(DATA,U,4)="" Q
.. S LST=LST+1
.. S LST(LST)=DATA
I +LST'=+INFO D
. K INFO
. M INFO=LST
S INFO(0)=INFO
Q
;
SAVESURR(OK,INFO,USER) ; from ORWTPP
; save user's surrogate info
N START,STOP,SURR,RET
S OK=1
S SURR=$P(INFO,U,1)
S START=$P(INFO,U,2)
S STOP=$P(INFO,U,3)
;TDP - Patch 539 added next lines for valid surrogate check
I +SURR>0,STOP'=0 D
. I USER=SURR S OK="0^You cannot specify yourself as your own surrogate!"
. I +OK=1 S OK=$$CHKSURRO^ORWTPUA(USER,SURR,START,STOP) ;No surrogate for surrogate
I +OK=0 Q
S RET=$$SAVESURR^ORWTPUA(USER,SURR,START,STOP)
I 'RET S OK="0^"_RET
Q
;
SAVENOTO(OK,INFO,USER) ; from ORWTPP
; save user's notification settings
N ERR,FLAG,VAL
S OK=1
S FLAG=$P(INFO,U,2) ;p415 changed from piece 3 to 2
S VAL=$S(FLAG>0:"Y",1:"@")
D EN^XPAR(USER_";VA(200,","ORB FLAGGED ORDERS BULLETIN",1,VAL,.ERR)
I $P(INFO,U,4)]"" D EN^XPAR(USER_";VA(200,","ORB DAYS FOR PROCESSED ALERTS",1,$P(INFO,U,4),.ERR)
I $P(INFO,U,5)]"" D EN^XPAR(USER_";VA(200,","ORB MAX PROCESSED ALERTS",1,$P(INFO,U,5),.ERR)
Q
;
OCDESC(TEXT,IEN) ; from RPC
N CNT,LINE,NUM K TEXT
S IEN=+$G(IEN) I IEN<1 Q
S TEXT(1)=$P($G(^ORD(100.8,IEN,0)),U)
S TEXT(2)=""
S CNT=2
S NUM=0 F S NUM=$O(^ORD(100.8,IEN,1,NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) D
.S CNT=CNT+1
.S TEXT(CNT)=LINE
S TEXT(CNT+1)=""
Q
;
NOTDESC(TEXT,IEN) ; from RPC
K TEXT
S IEN=+$G(IEN) I IEN<1 Q
S TEXT(1)=$P($G(^ORD(100.9,IEN,0)),U)
S TEXT(2)=""
S TEXT(3)=$P($G(^ORD(100.9,IEN,4)),U)
S TEXT(4)=""
Q
GETARCHP(INFO) ; from RPC
N LIST,L
S INFO=0
D GETLST^XPAR(.LIST,"DIV^SYS^PKG","ORB ARCHIVE PERIOD",,.ERROR)
F L=1:1:LIST S INFO=$S(INFO<$P(LIST(L),U,2):$P(LIST(L),U,2),1:INFO)
Q
;
SVSRDFLT(OK,VALUES) ; save surrogate defaults
;
S OK=1
I $G(VALUES)="" S OK="-1^Input parameter is missing" Q
S VALUES=$TR(VALUES,"^",",")
I +VALUES=0 S VALUES=0
D EN^XPAR("USR","ORQQXQ SURROGATE DEFAULTS",,VALUES,.OK)
Q
;
GTSRDFLT(OK,VALUES) ; retrieve surrogate defaults
;
N USER
S USER=+$G(VALUES)
I USER=0 S USER=DUZ
S OK=$$GET^XPAR("ALL","ORQQXQ SURROGATE DEFAULTS",,"Q")
I +OK=0 S OK=0
I OK["," S OK=$TR(OK,",","^")
Q
VLDSRDFL(X) ; validation code for surrogate defaults
;
N X2
I +X=1,X'?.1N1","1.2N Q 0
I "^1^0^"'[(U_+$P(X,",")_U) Q 0
S X2=$P(X,",",2)
I +X=0,X2'="" Q 0
I +X=1,'((+X2>=1)&(+X2<=30)) Q 0
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWTPR 6086 printed Oct 16, 2024@18:38:10 Page 2
ORWTPR ;SLC/STAFF - Personal Preference, Reminders ;Jun 22, 2021@14:06:23
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,173,215,243,280,415,458,539,405**;Oct 24, 2000;Build 211
+2 ;
GETREM(VALUES,USER) ; from ORWTPP
+1 ; get user's reminders
+2 NEW CLASS,CNT,ERR,IEN,NUM,OK,TMPLIST,ZERO
KILL VALUES
+3 DO GETLST^XPAR(.TMPLIST,"USR.`"_USER,"ORQQPX SEARCH ITEMS","Q",.ERR)
+4 SET CNT=0
SET IEN=0
FOR
SET IEN=$ORDER(^PXD(811.9,IEN))
if IEN<1
QUIT
SET ZERO=$GET(^(IEN,0))
IF $LENGTH($PIECE(ZERO,U,3))
IF '$PIECE(ZERO,U,6)
Begin DoDot:1
+5 SET CNT=CNT+1
+6 SET VALUES(CNT)=IEN_"^0^"_$PIECE(ZERO,U,3)_U_$PIECE(ZERO,U)
+7 SET CLASS=$PIECE($GET(^PXD(811.9,IEN,100)),U)
+8 SET $PIECE(VALUES(CNT),U,5)=$SELECT(CLASS="N":"NATIONAL",CLASS="L":"LOCAL",1:CLASS)
+9 SET OK=0
SET NUM=0
FOR
SET NUM=$ORDER(TMPLIST(NUM))
if NUM<1
QUIT
Begin DoDot:2
+10 IF IEN=$PIECE(TMPLIST(NUM),U,2)
SET OK=1
End DoDot:2
if OK
QUIT
+11 IF OK
SET $PIECE(VALUES(CNT),U,2)=$PIECE(TMPLIST(NUM),U)
End DoDot:1
+12 QUIT
+13 ;
SETREM(OK,VALUES,USER) ; from ORWTPP
+1 ; save user's reminders
+2 NEW NUM,ERR
+3 SET OK=1
+4 DO NDEL^XPAR("USR.`"_USER,"ORQQPX SEARCH ITEMS",.ERR)
+5 SET NUM=0
FOR
SET NUM=$ORDER(VALUES(NUM))
if NUM<1
QUIT
Begin DoDot:1
+6 DO EN^XPAR(USER_";VA(200,","ORQQPX SEARCH ITEMS",$PIECE(VALUES(NUM),U,1),"`"_$PIECE(VALUES(NUM),U,2),.ERR)
End DoDot:1
+7 QUIT
+8 ;
GETOC(VALUES,USER) ; from ORWTPP
+1 ; get user's order checks
+2 NEW CNT,IEN,LIST,NUM,VAL,VALOK
KILL LIST,VALUES
+3 SET IEN=0
FOR
SET IEN=$ORDER(^ORD(100.8,IEN))
if IEN<1
QUIT
Begin DoDot:1
+4 SET VAL=$$GET^XPAR("ALL","ORK PROCESSING FLAG",IEN,"I")
+5 IF '$LENGTH(VAL)
QUIT
+6 SET VALOK=$$GET^XPAR("ALL","ORK EDITABLE BY USER",IEN,"I")
+7 SET LIST(IEN)=VAL_U_VALOK
End DoDot:1
+8 SET NUM=0
SET CNT=0
FOR
SET NUM=$ORDER(LIST(NUM))
if NUM<1
QUIT
Begin DoDot:1
+9 SET CNT=CNT+1
+10 SET VALUES(CNT)=NUM_U_$PIECE($GET(^ORD(100.8,NUM,0)),U)_U_$SELECT($PIECE(LIST(NUM),U)="E":"ON",1:"OFF")_U_$SELECT($PIECE(LIST(NUM),U,2)="0":"MANDATORY",1:"")
End DoDot:1
+11 QUIT
+12 ;
SAVEOC(OK,VALUES,USER) ; from ORWTPP
+1 ; save user's order checks
+2 NEW NUM,ERR
+3 SET OK=1
+4 SET NUM=0
FOR
SET NUM=$ORDER(VALUES(NUM))
if NUM<1
QUIT
Begin DoDot:1
+5 DO EN^XPAR(USER_";VA(200,","ORK PROCESSING FLAG","`"_+VALUES(NUM),$SELECT($PIECE(VALUES(NUM),U,2)="ON":"E",1:"D"),.ERR)
End DoDot:1
+6 QUIT
+7 ;
+8 ;
GETNOT(VALUES,USER) ; from ORWTPP
+1 ; get user's notifications
+2 NEW CNT,IEN,NAME,RESULT
KILL VALUES
+3 SET CNT=0
+4 SET NAME=""
FOR
SET NAME=$ORDER(^ORD(100.9,"B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+5 SET IEN=0
FOR
SET IEN=$ORDER(^ORD(100.9,"B",NAME,IEN))
if IEN<1
QUIT
Begin DoDot:2
+6 ;458 added flag to check for mandatory
NEW ORMNDFLG
SET ORMNDFLG=0
+7 SET RESULT=$$ONOFF^ORB3USER(IEN,USER,"","")
IF $LENGTH($GET(RESULT))
Begin DoDot:3
+8 SET CNT=CNT+1
+9 SET VALUES(CNT)=IEN_U_NAME_U_$PIECE(RESULT,U)_U_$SELECT(ORMNDFLG:"MANDATORY",1:"")
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
SAVENOT(OK,VALUES,USER) ; from ORWTPP
+1 ; save user's notifications
+2 NEW ERR,NUM
+3 SET OK=1
+4 SET NUM=0
FOR
SET NUM=$ORDER(VALUES(NUM))
if NUM<1
QUIT
Begin DoDot:1
+5 DO EN^XPAR(USER_";VA(200,","ORB PROCESSING FLAG","`"_+VALUES(NUM),$SELECT($PIECE(VALUES(NUM),U,2)="ON":"E",1:"D"),.ERR)
End DoDot:1
+6 QUIT
+7 ;
CLEARNOT(OK,USER) ; from ORWTPP
+1 ; clear user's notifications
+2 ;ICR(DBIA) #3010
DO RECIPURG^XQALBUTL(USER)
+3 SET OK=1
+4 QUIT
+5 ;
GETNOTO(INFO,USER) ; from ORWTPP
+1 ; get user's other info for notifications
+2 IF $$GET^XPAR("USR.`"_USER,"ORB FLAGGED ORDERS BULLETIN",1,"Q")="Y"
SET $PIECE(INFO,U,2)=1
+3 IF $$GET^XPAR("ALL^USR.`"_USER,"ORB ERASE ALL",1,"Q")
SET $PIECE(INFO,U,3)=1
+4 SET $PIECE(INFO,U,4)=$$GET^XPAR("USR.`"_USER,"ORB DAYS FOR PROCESSED ALERTS",1,"Q")
+5 SET $PIECE(INFO,U,5)=$$GET^XPAR("USR.`"_USER,"ORB MAX PROCESSED ALERTS",1,"Q")
+6 QUIT
+7 ;
GETSURR(INFO,USER) ; from ORWTPP
+1 ; get user's surrogate info
+2 NEW SURR
+3 ;ICR(DBIA) #2790
DO SUROLIST^XQALSURO(USER,.SURR)
+4 SET INFO=$GET(SURR(1))
+5 QUIT
+6 ;
GETSURRS(INFO,USER) ; from ORWTPP ;TDP - Added for CPRSv32A (*539) surrogate modifications
+1 ; get all user's surrogate info
+2 NEW DATA,LST,X
+3 KILL INFO
+4 SET INFO=""
+5 ;ICR(DBIA) #2790
DO SUROLIST^XQALSURO(USER,.INFO)
+6 SET LST=0
+7 IF +INFO>0
Begin DoDot:1
+8 SET X=0
FOR
SET X=$ORDER(INFO(X))
if X=""
QUIT
Begin DoDot:2
+9 SET DATA=$GET(INFO(X))
+10 IF $PIECE(DATA,U,3)=$PIECE(DATA,U,4)
IF $PIECE(DATA,U,3)'=""
IF $PIECE(DATA,U,4)'=""
QUIT
+11 ;I $P(DATA,U,3)="",$P(DATA,U,4)="" Q
+12 SET LST=LST+1
+13 SET LST(LST)=DATA
End DoDot:2
End DoDot:1
+14 IF +LST'=+INFO
Begin DoDot:1
+15 KILL INFO
+16 MERGE INFO=LST
End DoDot:1
+17 SET INFO(0)=INFO
+18 QUIT
+19 ;
SAVESURR(OK,INFO,USER) ; from ORWTPP
+1 ; save user's surrogate info
+2 NEW START,STOP,SURR,RET
+3 SET OK=1
+4 SET SURR=$PIECE(INFO,U,1)
+5 SET START=$PIECE(INFO,U,2)
+6 SET STOP=$PIECE(INFO,U,3)
+7 ;TDP - Patch 539 added next lines for valid surrogate check
+8 IF +SURR>0
IF STOP'=0
Begin DoDot:1
+9 IF USER=SURR
SET OK="0^You cannot specify yourself as your own surrogate!"
+10 ;No surrogate for surrogate
IF +OK=1
SET OK=$$CHKSURRO^ORWTPUA(USER,SURR,START,STOP)
End DoDot:1
+11 IF +OK=0
QUIT
+12 SET RET=$$SAVESURR^ORWTPUA(USER,SURR,START,STOP)
+13 IF 'RET
SET OK="0^"_RET
+14 QUIT
+15 ;
SAVENOTO(OK,INFO,USER) ; from ORWTPP
+1 ; save user's notification settings
+2 NEW ERR,FLAG,VAL
+3 SET OK=1
+4 ;p415 changed from piece 3 to 2
SET FLAG=$PIECE(INFO,U,2)
+5 SET VAL=$SELECT(FLAG>0:"Y",1:"@")
+6 DO EN^XPAR(USER_";VA(200,","ORB FLAGGED ORDERS BULLETIN",1,VAL,.ERR)
+7 IF $PIECE(INFO,U,4)]""
DO EN^XPAR(USER_";VA(200,","ORB DAYS FOR PROCESSED ALERTS",1,$PIECE(INFO,U,4),.ERR)
+8 IF $PIECE(INFO,U,5)]""
DO EN^XPAR(USER_";VA(200,","ORB MAX PROCESSED ALERTS",1,$PIECE(INFO,U,5),.ERR)
+9 QUIT
+10 ;
OCDESC(TEXT,IEN) ; from RPC
+1 NEW CNT,LINE,NUM
KILL TEXT
+2 SET IEN=+$GET(IEN)
IF IEN<1
QUIT
+3 SET TEXT(1)=$PIECE($GET(^ORD(100.8,IEN,0)),U)
+4 SET TEXT(2)=""
+5 SET CNT=2
+6 SET NUM=0
FOR
SET NUM=$ORDER(^ORD(100.8,IEN,1,NUM))
if NUM<1
QUIT
SET LINE=$GET(^(NUM,0))
Begin DoDot:1
+7 SET CNT=CNT+1
+8 SET TEXT(CNT)=LINE
End DoDot:1
+9 SET TEXT(CNT+1)=""
+10 QUIT
+11 ;
NOTDESC(TEXT,IEN) ; from RPC
+1 KILL TEXT
+2 SET IEN=+$GET(IEN)
IF IEN<1
QUIT
+3 SET TEXT(1)=$PIECE($GET(^ORD(100.9,IEN,0)),U)
+4 SET TEXT(2)=""
+5 SET TEXT(3)=$PIECE($GET(^ORD(100.9,IEN,4)),U)
+6 SET TEXT(4)=""
+7 QUIT
GETARCHP(INFO) ; from RPC
+1 NEW LIST,L
+2 SET INFO=0
+3 DO GETLST^XPAR(.LIST,"DIV^SYS^PKG","ORB ARCHIVE PERIOD",,.ERROR)
+4 FOR L=1:1:LIST
SET INFO=$SELECT(INFO<$PIECE(LIST(L),U,2):$PIECE(LIST(L),U,2),1:INFO)
+5 QUIT
+6 ;
SVSRDFLT(OK,VALUES) ; save surrogate defaults
+1 ;
+2 SET OK=1
+3 IF $GET(VALUES)=""
SET OK="-1^Input parameter is missing"
QUIT
+4 SET VALUES=$TRANSLATE(VALUES,"^",",")
+5 IF +VALUES=0
SET VALUES=0
+6 DO EN^XPAR("USR","ORQQXQ SURROGATE DEFAULTS",,VALUES,.OK)
+7 QUIT
+8 ;
GTSRDFLT(OK,VALUES) ; retrieve surrogate defaults
+1 ;
+2 NEW USER
+3 SET USER=+$GET(VALUES)
+4 IF USER=0
SET USER=DUZ
+5 SET OK=$$GET^XPAR("ALL","ORQQXQ SURROGATE DEFAULTS",,"Q")
+6 IF +OK=0
SET OK=0
+7 IF OK[","
SET OK=$TRANSLATE(OK,",","^")
+8 QUIT
VLDSRDFL(X) ; validation code for surrogate defaults
+1 ;
+2 NEW X2
+3 IF +X=1
IF X'?.1N1","1.2N
QUIT 0
+4 IF "^1^0^"'[(U_+$PIECE(X,",")_U)
QUIT 0
+5 SET X2=$PIECE(X,",",2)
+6 IF +X=0
IF X2'=""
QUIT 0
+7 IF +X=1
IF '((+X2>=1)&(+X2<=30))
QUIT 0
+8 QUIT 1
