| [613] | 1 | ORWDAL33 ;SLC/DAN - Allergy calls to support windows ;7/27/06 11:03
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,260**;Dec 17, 1997;Build 26
|
|---|
| 3 | ;
|
|---|
| 4 | CLINUSER(ORY) ;can user mark allergy as entered in error
|
|---|
| 5 | N DIC,X,PRM,Y,ORLST,ORX,PLIST,VALUE
|
|---|
| 6 | S DIC=8989.51,DIC(0)="MX",X="OR ALLERGY ENTERED IN ERROR" D ^DIC
|
|---|
| 7 | I Y=-1 S ORY=0 Q ;Parameter not found so quit
|
|---|
| 8 | S PRM=+Y
|
|---|
| 9 | ;Check USER level
|
|---|
| 10 | S ORY=$$GET^XPAR("USR",PRM) I ORY'="" Q
|
|---|
| 11 | ;Check USER CLASS
|
|---|
| 12 | D ENVAL^XPAR(.ORLST,PRM)
|
|---|
| 13 | I ORLST>0 D
|
|---|
| 14 | . S ORX="" F S ORX=$O(ORLST(ORX)) Q:ORX="" D
|
|---|
| 15 | . . Q:ORX'["USR(8930"
|
|---|
| 16 | . . I $$ISA^USRLM(DUZ,+ORX) S VALUE(+ORX)=ORLST(ORX,1)
|
|---|
| 17 | . S ORX=0 F S ORX=$O(VALUE(ORX)) Q:'+ORX D REMOVE(ORX)
|
|---|
| 18 | . S ORX=0 F S ORX=$O(VALUE(ORX)) Q:'+ORX S VALUE=$G(VALUE)!(VALUE(ORX))
|
|---|
| 19 | S ORY=$G(VALUE)
|
|---|
| 20 | I ORY'="" Q
|
|---|
| 21 | ;Check division and system
|
|---|
| 22 | S ORY=$$GET^XPAR("DIV^SYS",PRM) I ORY'="" Q
|
|---|
| 23 | S ORY=0 Q
|
|---|
| 24 | ;
|
|---|
| 25 | REMOVE(SUB) ;Remove values at higher level classes
|
|---|
| 26 | N IEN
|
|---|
| 27 | S IEN=0 F S IEN=$O(^USR(8930,"AD",SUB,IEN)) Q:'+IEN D
|
|---|
| 28 | .I $D(^USR(8930,"AD",IEN)) D REMOVE(IEN) ;Recursive call
|
|---|
| 29 | .K VALUE(IEN)
|
|---|
| 30 | Q
|
|---|
