31 lines
1.0 KiB
Mathematica
31 lines
1.0 KiB
Mathematica
ORWDAL33 ;SLC/DAN - Allergy calls to support windows ;7/27/06 11:03
|
|
;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,260**;Dec 17, 1997;Build 26
|
|
;
|
|
CLINUSER(ORY) ;can user mark allergy as entered in error
|
|
N DIC,X,PRM,Y,ORLST,ORX,PLIST,VALUE
|
|
S DIC=8989.51,DIC(0)="MX",X="OR ALLERGY ENTERED IN ERROR" D ^DIC
|
|
I Y=-1 S ORY=0 Q ;Parameter not found so quit
|
|
S PRM=+Y
|
|
;Check USER level
|
|
S ORY=$$GET^XPAR("USR",PRM) I ORY'="" Q
|
|
;Check USER CLASS
|
|
D ENVAL^XPAR(.ORLST,PRM)
|
|
I ORLST>0 D
|
|
. S ORX="" F S ORX=$O(ORLST(ORX)) Q:ORX="" D
|
|
. . Q:ORX'["USR(8930"
|
|
. . I $$ISA^USRLM(DUZ,+ORX) S VALUE(+ORX)=ORLST(ORX,1)
|
|
. S ORX=0 F S ORX=$O(VALUE(ORX)) Q:'+ORX D REMOVE(ORX)
|
|
. S ORX=0 F S ORX=$O(VALUE(ORX)) Q:'+ORX S VALUE=$G(VALUE)!(VALUE(ORX))
|
|
S ORY=$G(VALUE)
|
|
I ORY'="" Q
|
|
;Check division and system
|
|
S ORY=$$GET^XPAR("DIV^SYS",PRM) I ORY'="" Q
|
|
S ORY=0 Q
|
|
;
|
|
REMOVE(SUB) ;Remove values at higher level classes
|
|
N IEN
|
|
S IEN=0 F S IEN=$O(^USR(8930,"AD",SUB,IEN)) Q:'+IEN D
|
|
.I $D(^USR(8930,"AD",IEN)) D REMOVE(IEN) ;Recursive call
|
|
.K VALUE(IEN)
|
|
Q
|