source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDAL33.m@ 1489

Last change on this file since 1489 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.0 KB
Line 
1ORWDAL33 ;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 ;
4CLINUSER(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 ;
25REMOVE(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
Note: See TracBrowser for help on using the repository browser.