Index: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWU.m
===================================================================
--- WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWU.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWU.m	(revision 623)
@@ -1,220 +1,216 @@
-ORWU	; SLC/KCM - General Utilites for Windows Calls; 2/28/01 [1/15/04 11:43am]
-	;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,132,148,149,187,195,215,243**;Dec 17, 1997;Build 242
-	;
-DT(Y,X,%DT)	; Internal Fileman Date/Time
-	; change the '00:00' that could be passed so Fileman doesn't reject
-	I $L($P(X,"@",2)),("00000000"[$TR($P(X,"@",2),":","")) S $P(X,"@",2)="00:00:01"
-	S %DT=$G(%DT,"TS") D ^%DT K %DT
-	Q
-VALDT(Y,X,%DT)	; Validate date/time
-	S:'$D(%DT) %DT="TX" D ^%DT
-	Q
-USERINFO(REC)	; Relevant info for current user
-	; return DUZ^NAME^USRCLS^CANSIGN^ISPROVIDER^ORDERROLE^NOORDER^DTIME^
-	;        COUNTDOWN^ENABLEVERIFY^NOTIFYAPPS^MSGHANG^DOMAIN^SERVICE^
-	;        AUTOSAVE^INITTAB^LASTTAB^WEBACCESS^ALLOWHOLD^ISRPL^RPLLIST^
-	;        CORTABS^RPTTAB^STANUM^GECSTATUS^PRODACCT
-	N X,ORRPL,ORRPL1,ORRPL2,ORTAB,CORTABS,RPTTAB,ORDT,OREFF,OREXP,ORDATEOK
-	S REC=DUZ_U_$P(^VA(200,DUZ,0),U)
-	S $P(REC,U,3)=$S($D(^XUSEC("ORES",DUZ)):3,$D(^XUSEC("ORELSE",DUZ)):2,$D(^XUSEC("OREMAS",DUZ)):1,1:0)
-	S $P(REC,U,4)=$D(^XUSEC("ORES",DUZ))&$D(^XUSEC("PROVIDER",DUZ))
-	S $P(REC,U,5)=$D(^XUSEC("PROVIDER",DUZ))
-	S $P(REC,U,6)=$$ORDROLE
-	S $P(REC,U,7)=$$GET^XPAR("USR^SYS^PKG","ORWOR DISABLE ORDERING",1,"I")
-	S $P(REC,U,8)=$$GET^XPAR("USR^SYS","ORWOR TIMEOUT CHART",1,"I")
-	I '$P(REC,U,8),$G(DTIME) S $P(REC,U,8)=DTIME
-	S $P(REC,U,9)=$$GET^XPAR("USR^SYS^PKG","ORWOR TIMEOUT COUNTDOWN",1,"I")
-	S X=$$GET^XPAR("USR^SYS^PKG","ORWOR ENABLE VERIFY",1,"I")
-	S $P(REC,U,10)=$S(X=1:1,X=2:0,1:'$P(REC,U,7))
-	S $P(REC,U,11)=$$GET^XPAR("USR^SYS^PKG","ORWOR BROADCAST MESSAGES",1,"I")
-	S $P(REC,U,12)=$$GET^XPAR("USR^SYS^PKG","ORWOR AUTO CLOSE PT MSG",1,"I")
-	S $P(REC,U,13)=$$KSP^XUPARAM("WHERE")  ; domain
-	S $P(REC,U,14)=+$G(^VA(200,DUZ,5))     ; service/section
-	S $P(REC,U,15)=$$GET^XPAR("USR^SYS^PKG","ORWOR AUTOSAVE NOTE",1,"I")
-	S $P(REC,U,16)=$$GET^XPAR("USR^DIV^SYS^PKG","ORCH INITIAL TAB",1,"I")
-	S $P(REC,U,17)=$$GET^XPAR("USR^DIV^SYS^PKG","ORCH USE LAST TAB",1,"I")
-	S $P(REC,U,18)=$$GET^XPAR("USR^DIV^SYS^PKG","ORWOR DISABLE WEB ACCESS",1,"I")
-	S $P(REC,U,19)=$$GET^XPAR("SYS^PKG","ORWOR DISABLE HOLD ORDERS",1,"I")
-	; 2 pieces added by PKS on 11/5/2001 for "Reports Only:"
-	; IA# 10060 allows read access to ^VA(200 file.
-	S ORRPL=$G(^VA(200,DUZ,101))           ; RPL node.
-	S ORRPL1=$P(ORRPL,U)
-	S $P(REC,U,20)=ORRPL1                  ; ISRPL piece.
-	S ORRPL2=$P(ORRPL,U,2)
-	S $P(REC,U,21)=ORRPL2                  ; RPLLIST piece.
-	;
-	; Additional pieces for CPRS tabs access:
-	; IA# 10060 allows read access to ^VA(200.01013 multiple.
-	S ORDT=DT                              ; Today.
-	S (CORTABS,RPTTAB)=0
-	S ORRPL=0
-	F  S ORRPL=$O(^VA(200,DUZ,"ORD",ORRPL)) Q:ORRPL<1  D
-	.S ORTAB=$G(^VA(200,DUZ,"ORD",ORRPL,0))
-	.I ORTAB="" Q
-	.S OREFF=$P(ORTAB,U,2)
-	.S OREXP=$P(ORTAB,U,3)
-	.S ORTAB=$P(ORTAB,U)
-	.I ORTAB="" Q
-	.S ORTAB=$G(^ORD(101.13,ORTAB,0))
-	.I ORTAB="" Q
-	.S ORTAB=$P(ORTAB,U)
-	.I ORTAB="" Q
-	.S ORTAB=$$UP^XLFSTR(ORTAB)
-	.S ORDATEOK=1                             ; Default.
-	.I ((OREFF="")!(OREFF>ORDT)) S ORDATEOK=0 ; Eff. date NG.
-	.I ORDATEOK  D
-	..I OREXP="" Q                            ; No exp. date.
-	..I (OREXP<ORDT) S ORDATEOK=0             ; Exp. date NG.
-	..I (OREXP=ORDT) S ORDATEOK=0             ; Exp. date NG.
-	.;
-	.; Set TRUE if OK:
-	.I ((ORTAB="COR")&(ORDATEOK)) S CORTABS=1
-	.I ((ORTAB="RPT")&(ORDATEOK)) S RPTTAB=1
-	;
-	; When done, set all valid tabs for access:
-	S $P(REC,U,22)=CORTABS                 ; "Core" tabs.
-	S $P(REC,U,23)=RPTTAB                  ; "Reports" tab.
-	;
-	S $P(REC,U,24)=$P($$SITE^VASITE,U,3)
-	S $P(REC,U,25)=$$GET^XPAR("USR^TEA","PXRM GEC STATUS CHECK",1,"I")
-	S $P(REC,U,26)=$$PROD^XUPROD
-	Q
-	;
-HASKEY(VAL,KEY)	; returns TRUE if the user possesses the security key
-	S VAL=''$D(^XUSEC(KEY,DUZ))
-	Q
-HASOPTN(VAL,OPTION)	; returns TRUE if the user has access to a menu option
-	S VAL=+$$ACCESS^XQCHK(DUZ,OPTION)
-	I VAL'>0 S VAL=0
-	E  S VAL=1
-	Q
-NPHASKEY(VAL,NP,KEY)	; returns TRUE if the person has the security key
-	S VAL=''$D(^XUSEC(KEY,NP))
-	Q
-ORDROLE()	; returns the role a person takes in ordering
-	; VAL: 0=nokey, 1=clerk, 2=nurse, 3=physician, 4=student, 5=bad keys
-	;I '$G(ORWCLVER) Q 0  ; version of client is to old for ordering
-	I ($D(^XUSEC("OREMAS",DUZ))+$D(^XUSEC("ORELSE",DUZ))+$D(^XUSEC("ORES",DUZ)))>1 Q 5
-	I $D(^XUSEC("OREMAS",DUZ)) Q 1                           ; clerk
-	I $D(^XUSEC("ORELSE",DUZ)) Q 2                           ; nurse
-	I $D(^XUSEC("ORES",DUZ)),$D(^XUSEC("PROVIDER",DUZ)) Q 3  ; doctor
-	I $D(^XUSEC("PROVIDER",DUZ)) Q 4                         ; student
-	Q 0
-VALIDSIG(ESOK,X)	; returns TRUE if valid electronic signature
-	S X=$$DECRYP^XUSRB1(X),ESOK=0                   ; network encrypted
-	D HASH^XUSHSHP
-	I X=$P($G(^VA(200,+DUZ,20)),U,4) S ESOK=1
-	Q
-TOOLMENU(ORLST)	; returns a list of items for the Tools menu
-	N ANENT
-	S ANENT="ALL^"_$S($G(^VA(200,DUZ,5)):"^SRV.`"_+$G(^(5)),1:"")
-	D GETLST^XPAR(.ORLST,ANENT,"ORWT TOOLS MENU","N")
-	Q
-ACTLOC(LOC)	; Function: returns TRUE if active hospital location
-	; IA# 10040.
-	N D0,X I +$G(^SC(LOC,"OOS")) Q 0                ; screen out OOS entry
-	S D0=+$G(^SC(LOC,42)) I D0 D WIN^DGPMDDCF Q 'X  ; chk out of svc wards
-	S X=$G(^SC(LOC,"I")) I +X=0 Q 1                 ; no inactivate date
-	I DT>$P(X,U)&($P(X,U,2)=""!(DT<$P(X,U,2))) Q 0  ; chk reactivate date
-	Q 1                                             ; must still be active
-	;
-CLINLOC(Y,FROM,DIR)	; Return a set of clinics from HOSPITAL LOCATION
-	; .Y=returned list, FROM=text to $O from, DIR=$O direction,
-	N I,IEN,CNT S I=0,CNT=44
-	F  Q:I'<CNT  S FROM=$O(^SC("B",FROM),DIR) Q:FROM=""  D  ; IA# 10040.
-	. S IEN="" F  S IEN=$O(^SC("B",FROM,IEN),DIR) Q:'IEN  D
-	. . I ($P($G(^SC(IEN,0)),U,3)'="C")!('$$ACTLOC(IEN)) Q
-	. . S I=I+1,Y(I)=IEN_"^"_FROM
-	Q
-INPLOC(Y,FROM,DIR)	;Return a set of wards from HOSPITAL LOCATION
-	; .Y=returned list, FROM=text to $O from, DIR=$O direction,
-	N I,IEN,CNT S I=0,CNT=44
-	F  Q:I'<CNT  S FROM=$O(^SC("B",FROM),DIR) Q:FROM=""  D  ; IA# 10040.
-	. S IEN="" F  S IEN=$O(^SC("B",FROM,IEN),DIR) Q:'IEN  D
-	. . I ($P($G(^SC(IEN,0)),U,3)'="W") Q
-	. . I '$$ACTLOC(IEN) Q
-	. . S I=I+1,Y(I)=IEN_"^"_FROM
-	Q
-HOSPLOC(Y,FROM,DIR)	; Return a set of locations from HOSPITAL LOCATION
-	; .Y=returned list, FROM=text to $O from, DIR=$O direction,
-	N I,IEN,CNT S I=0,CNT=44
-	F  Q:I'<CNT  S FROM=$O(^SC("B",FROM),DIR) Q:FROM=""  D  ; IA# 10040.
-	. S IEN="" F  S IEN=$O(^SC("B",FROM,IEN),DIR) Q:'IEN  D
-	. . Q:("CW"'[$P($G(^SC(IEN,0)),U,3)!('$$ACTLOC(IEN)))
-	. . S I=I+1,Y(I)=IEN_"^"_FROM
-	Q
-NEWPERS(ORY,ORFROM,ORDIR,ORKEY,ORDATE,ORVIZ,ORALL)	; Return a set of names from the NEW PERSON file.
-	; SLC/PKS: Code moved to ORWU1 on 12/3/2002.
-	D NP1^ORWU1
-	Q
-GBLREF(VAL,FN)	; return global reference for file number
-	S VAL="" Q:'FN
-	S VAL=$$ROOT^DILFD(+FN)
-	; I $E($RE(VAL))="," S VAL=$E(VAL,1,$L(VAL)-1)_")"
-	; I $E($RE(VAL))="(" S VAL=$P(VAL,"(",1) 
-	Q
-GENERIC(Y,FROM,DIR,REF)	; Return a set of entries from xref in REF
-	; .Y=returned list, FROM=text to $O from, DIR=$O direction,
-	N I,IEN,CNT S I=0,CNT=44
-	F  Q:I'<CNT  S FROM=$O(@REF@(FROM),DIR) Q:FROM=""  D
-	. S IEN="" F  S IEN=$O(@REF@(FROM,IEN),DIR) Q:'IEN  D
-	. . S I=I+1,Y(I)=IEN_"^"_FROM
-	Q
-EXTNAME(VAL,IEN,FN)	; return external form of pointer
-	; IEN=internal number, FN=file number
-	N REF S REF=$G(^DIC(FN,0,"GL")),VAL=""
-	I $L(REF),+IEN S VAL=$P($G(@(REF_IEN_",0)")),U)
-	Q
-PARAM(VAL,APARAM)	; return a parameter value for a user
-	; call assumes current user, default entities, single instance
-	S VAL=$$GET^XPAR("ALL",APARAM,1,"I")
-	Q
-PARAMS(ORLIST,APARAM)	; return a list of parameter values
-	; call assumes current user, default entities, multiple instances
-	D GETLST^XPAR(.ORLIST,"ALL",APARAM,"Q")
-	Q
-DEVICE(Y,FROM,DIR)	; Return a subset of entries from the Device file
-	; .LST(n)=IEN;Name^DisplayName^Location^RMar^PLen
-	; FROM=text to $O from, DIR=$O direction
-	N I,IEN,CNT,SHOW,X S I=0,CNT=20
-	I FROM["<" S FROM=$RE($P($RE(FROM),"<  ",2))
-	F  Q:I'<CNT  S FROM=$O(^%ZIS(1,"B",FROM),DIR) Q:FROM=""  D
-	. S IEN=0 F  S IEN=$O(^%ZIS(1,"B",FROM,IEN)) Q:'IEN  D
-	.. N X0,X1,X90,X91,X95,XTYPE,XSTYPE,XTIME,ORA,ORPX,POP
-	.. Q:'$D(^%ZIS(1,IEN,0))  S X0=^(0),X1=$G(^(1)),X90=$G(^(90)),X91=$G(^(91)),X95=$G(^(95)),XSTYPE=$G(^("SUBTYPE")),XTIME=$G(^("TIME")),XTYPE=$G(^("TYPE"))
-	.. I $E($G(^%ZIS(2,+XSTYPE,0)))'="P" Q  ;Printers only
-	.. S X=$P(XTYPE,"^") I X'="TRM",X'="HG",X'="HFS",X'="CHAN" Q  ;Device Types
-	.. S X=X0 I ($P(X,U,2)="0")!($P(X,U,12)=2) Q  ;Queuing allowed
-	.. S X=+X90 I X,(X'>DT) Q  ;Out of Service
-	.. I XTIME]"" S ORA=$P(XTIME,"^"),ORPX=$P($H,",",2),ORPCNT=ORPX\60#60+(ORPX\3600*100),ORPX=$P(ORA,"-",2) I ORPX'<ORA&(ORPCNT'>ORPX&(ORPCNT'<ORA))!(ORPX<ORA&(ORPCNT'<ORA!(ORPCNT'>ORPX))) Q  ;Prohibited Times
-	.. S POP=0
-	.. I X95]"" S ORPX=$G(DUZ(0)) I ORPX'="@" S POP=1 F ORA=1:1:$L(ORPX) I X95[$E(ORPX,ORA) S POP=0 Q
-	.. Q:POP  ;Security check
-	.. S SHOW=$P(X0,U) I SHOW'=FROM S SHOW=FROM_"  <"_SHOW_">"
-	.. S I=I+1,Y(I)=IEN_";"_$P(X0,U)_U_SHOW_U_$P(X1,U)_U_$P(X91,U)_U_$P(X91,U,3)
-	Q
-URGENCY(Y)	; -- retrieve set values from dd for discharge summary urgency
-	N ORDD,I,X
-	D FIELD^DID(8925,.09,"","POINTER","ORDD")
-	F I=1:1 S X=$P(ORDD("POINTER"),";",I) Q:X=""   S Y(I)=$TR(X,":","^")
-	Q
-PATCH(VAL,X)	; Return 1 if patch X is installed
-	S VAL=$$PATCH^XPDUTL(X)
-	Q
-VERSION(VAL,X)	;Return version of package or namespace
-	S VAL=$$VERSION^XPDUTL(X)
-	Q
-VERSRV(VAL,X,CLVER)	; Return server version of option name
-	S ORWCLVER=$G(CLVER)  ; leave in partition for session
-	N BADVAL,ORLST
-	D FIND^DIC(19,"",1,"X",X,1,,,,"ORLST")
-	I 'ORLST("DILIST",0) S VAL="0.0.0.0" Q
-	S VAL=ORLST("DILIST","ID",1,1)
-	S VAL=$P(VAL,"version ",2)
-	S BADVAL=0
-	I $P(VAL,".",1)="" S BADVAL=1
-	I $P(VAL,".",2)="" S BADVAL=1
-	I $P(VAL,".",3)="" S BADVAL=1
-	I $P(VAL,".",4)="" S BADVAL=1
-	I ((BADVAL)!('VAL)!(VAL="")) S VAL="0.0.0.0"
-	Q
+ORWU ; SLC/KCM - General Utilites for Windows Calls; 2/28/01 [1/15/04 11:43am]
+ ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,132,148,149,187,195,215**;Dec 17, 1997
+ ;
+DT(Y,X,%DT) ; Internal Fileman Date/Time
+ ; change the '00:00' that could be passed so Fileman doesn't reject
+ I $L($P(X,"@",2)),("00000000"[$TR($P(X,"@",2),":","")) S $P(X,"@",2)="00:00:01"
+ S %DT=$G(%DT,"TS") D ^%DT K %DT
+ Q
+VALDT(Y,X,%DT) ; Validate date/time
+ S:'$D(%DT) %DT="TX" D ^%DT
+ Q
+USERINFO(REC) ; Relevant info for current user
+ ; return DUZ^NAME^USRCLS^CANSIGN^ISPROVIDER^ORDERROLE^NOORDER^DTIME^
+ ;        COUNTDOWN^ENABLEVERIFY^NOTIFYAPPS^MSGHANG^DOMAIN^SERVICE^
+ ;        AUTOSAVE^INITTAB^LASTTAB^WEBACCESS^ALLOWHOLD^ISRPL^RPLLIST^
+ ;        CORTABS^RPTTAB^STANUM^GECSTATUS^PRODACCT
+ N X,ORRPL,ORRPL1,ORRPL2,ORTAB,CORTABS,RPTTAB,ORDT,OREFF,OREXP,ORDATEOK
+ S REC=DUZ_U_$P(^VA(200,DUZ,0),U)
+ S $P(REC,U,3)=$S($D(^XUSEC("ORES",DUZ)):3,$D(^XUSEC("ORELSE",DUZ)):2,$D(^XUSEC("OREMAS",DUZ)):1,1:0)
+ S $P(REC,U,4)=$D(^XUSEC("ORES",DUZ))&$D(^XUSEC("PROVIDER",DUZ))
+ S $P(REC,U,5)=$D(^XUSEC("PROVIDER",DUZ))
+ S $P(REC,U,6)=$$ORDROLE
+ S $P(REC,U,7)=$$GET^XPAR("USR^SYS^PKG","ORWOR DISABLE ORDERING",1,"I")
+ S $P(REC,U,8)=$$GET^XPAR("USR^SYS","ORWOR TIMEOUT CHART",1,"I")
+ I '$P(REC,U,8),$G(DTIME) S $P(REC,U,8)=DTIME
+ S $P(REC,U,9)=$$GET^XPAR("USR^SYS^PKG","ORWOR TIMEOUT COUNTDOWN",1,"I")
+ S X=$$GET^XPAR("USR^SYS^PKG","ORWOR ENABLE VERIFY",1,"I")
+ S $P(REC,U,10)=$S(X=1:1,X=2:0,1:'$P(REC,U,7))
+ S $P(REC,U,11)=$$GET^XPAR("USR^SYS^PKG","ORWOR BROADCAST MESSAGES",1,"I")
+ S $P(REC,U,12)=$$GET^XPAR("USR^SYS^PKG","ORWOR AUTO CLOSE PT MSG",1,"I")
+ S $P(REC,U,13)=$$KSP^XUPARAM("WHERE")  ; domain
+ S $P(REC,U,14)=+$G(^VA(200,DUZ,5))     ; service/section
+ S $P(REC,U,15)=$$GET^XPAR("USR^SYS^PKG","ORWOR AUTOSAVE NOTE",1,"I")
+ S $P(REC,U,16)=$$GET^XPAR("USR^DIV^SYS^PKG","ORCH INITIAL TAB",1,"I")
+ S $P(REC,U,17)=$$GET^XPAR("USR^DIV^SYS^PKG","ORCH USE LAST TAB",1,"I")
+ S $P(REC,U,18)=$$GET^XPAR("USR^DIV^SYS^PKG","ORWOR DISABLE WEB ACCESS",1,"I")
+ S $P(REC,U,19)=$$GET^XPAR("SYS^PKG","ORWOR DISABLE HOLD ORDERS",1,"I")
+ ; 2 pieces added by PKS on 11/5/2001 for "Reports Only:"
+ ; IA# 10060 allows read access to ^VA(200 file.
+ S ORRPL=$G(^VA(200,DUZ,101))           ; RPL node.
+ S ORRPL1=$P(ORRPL,U)
+ S $P(REC,U,20)=ORRPL1                  ; ISRPL piece.
+ S ORRPL2=$P(ORRPL,U,2)
+ S $P(REC,U,21)=ORRPL2                  ; RPLLIST piece.
+ ;
+ ; Additional pieces for CPRS tabs access:
+ ; IA# 10060 allows read access to ^VA(200.01013 multiple.
+ S ORDT=DT                              ; Today.
+ S (CORTABS,RPTTAB)=0
+ S ORRPL=0
+ F  S ORRPL=$O(^VA(200,DUZ,"ORD",ORRPL)) Q:ORRPL<1  D
+ .S ORTAB=$G(^VA(200,DUZ,"ORD",ORRPL,0))
+ .I ORTAB="" Q
+ .S OREFF=$P(ORTAB,U,2)
+ .S OREXP=$P(ORTAB,U,3)
+ .S ORTAB=$P(ORTAB,U)
+ .I ORTAB="" Q
+ .S ORTAB=$G(^ORD(101.13,ORTAB,0))
+ .I ORTAB="" Q
+ .S ORTAB=$P(ORTAB,U)
+ .I ORTAB="" Q
+ .S ORTAB=$$UP^XLFSTR(ORTAB)
+ .S ORDATEOK=1                             ; Default.
+ .I ((OREFF="")!(OREFF>ORDT)) S ORDATEOK=0 ; Eff. date NG.
+ .I ORDATEOK  D
+ ..I OREXP="" Q                            ; No exp. date.
+ ..I (OREXP<ORDT) S ORDATEOK=0             ; Exp. date NG.
+ ..I (OREXP=ORDT) S ORDATEOK=0             ; Exp. date NG.
+ .;
+ .; Set TRUE if OK:
+ .I ((ORTAB="COR")&(ORDATEOK)) S CORTABS=1
+ .I ((ORTAB="RPT")&(ORDATEOK)) S RPTTAB=1
+ ;
+ ; When done, set all valid tabs for access:
+ S $P(REC,U,22)=CORTABS                 ; "Core" tabs.
+ S $P(REC,U,23)=RPTTAB                  ; "Reports" tab.
+ ;
+ S $P(REC,U,24)=$P($$SITE^VASITE,U,3)
+ S $P(REC,U,25)=$$GET^XPAR("USR^TEA","PXRM GEC STATUS CHECK",1,"I")
+ S $P(REC,U,26)=$$PROD^XUPROD
+ Q
+ ;
+HASKEY(VAL,KEY) ; returns TRUE if the user possesses the security key
+ S VAL=''$D(^XUSEC(KEY,DUZ))
+ Q
+HASOPTN(VAL,OPTION) ; returns TRUE if the user has access to a menu option
+ S VAL=+$$ACCESS^XQCHK(DUZ,OPTION)
+ I VAL'>0 S VAL=0
+ E  S VAL=1
+ Q
+NPHASKEY(VAL,NP,KEY)    ; returns TRUE if the person has the security key
+ S VAL=''$D(^XUSEC(KEY,NP))
+ Q
+ORDROLE()    ; returns the role a person takes in ordering
+ ; VAL: 0=nokey, 1=clerk, 2=nurse, 3=physician, 4=student, 5=bad keys
+ ;I '$G(ORWCLVER) Q 0  ; version of client is to old for ordering
+ I ($D(^XUSEC("OREMAS",DUZ))+$D(^XUSEC("ORELSE",DUZ))+$D(^XUSEC("ORES",DUZ)))>1 Q 5
+ I $D(^XUSEC("OREMAS",DUZ)) Q 1                           ; clerk
+ I $D(^XUSEC("ORELSE",DUZ)) Q 2                           ; nurse
+ I $D(^XUSEC("ORES",DUZ)),$D(^XUSEC("PROVIDER",DUZ)) Q 3  ; doctor
+ I $D(^XUSEC("PROVIDER",DUZ)) Q 4                         ; student
+ Q 0
+VALIDSIG(ESOK,X) ; returns TRUE if valid electronic signature
+ S X=$$DECRYP^XUSRB1(X),ESOK=0                   ; network encrypted
+ D HASH^XUSHSHP
+ I X=$P($G(^VA(200,+DUZ,20)),U,4) S ESOK=1
+ Q
+TOOLMENU(ORLST) ; returns a list of items for the Tools menu
+ N ANENT
+ S ANENT="ALL^"_$S($G(^VA(200,DUZ,5)):"^SRV.`"_+$G(^(5)),1:"")
+ D GETLST^XPAR(.ORLST,ANENT,"ORWT TOOLS MENU","N")
+ Q
+ACTLOC(LOC) ; Function: returns TRUE if active hospital location
+ ; IA# 10040.
+ N D0,X I +$G(^SC(LOC,"OOS")) Q 0                ; screen out OOS entry
+ S D0=+$G(^SC(LOC,42)) I D0 D WIN^DGPMDDCF Q 'X  ; chk out of svc wards
+ S X=$G(^SC(LOC,"I")) I +X=0 Q 1                 ; no inactivate date
+ I DT>$P(X,U)&($P(X,U,2)=""!(DT<$P(X,U,2))) Q 0  ; chk reactivate date
+ Q 1                                             ; must still be active
+ ;
+CLINLOC(Y,FROM,DIR) ; Return a set of clinics from HOSPITAL LOCATION
+ ; .Y=returned list, FROM=text to $O from, DIR=$O direction,
+ N I,IEN,CNT S I=0,CNT=44
+ F  Q:I'<CNT  S FROM=$O(^SC("B",FROM),DIR) Q:FROM=""  D  ; IA# 10040.
+ . S IEN="" F  S IEN=$O(^SC("B",FROM,IEN),DIR) Q:'IEN  D
+ . . I ($P($G(^SC(IEN,0)),U,3)'="C")!('$$ACTLOC(IEN)) Q
+ . . S I=I+1,Y(I)=IEN_"^"_FROM
+ Q
+INPLOC(Y,FROM,DIR) ;Return a set of wards from HOSPITAL LOCATION
+ ; .Y=returned list, FROM=text to $O from, DIR=$O direction,
+ N I,IEN,CNT S I=0,CNT=44
+ F  Q:I'<CNT  S FROM=$O(^SC("B",FROM),DIR) Q:FROM=""  D  ; IA# 10040.
+ . S IEN="" F  S IEN=$O(^SC("B",FROM,IEN),DIR) Q:'IEN  D
+ . . I ($P($G(^SC(IEN,0)),U,3)'="W") Q
+ . . I '$$ACTLOC(IEN) Q
+ . . S I=I+1,Y(I)=IEN_"^"_FROM
+ Q
+HOSPLOC(Y,FROM,DIR) ; Return a set of locations from HOSPITAL LOCATION
+ ; .Y=returned list, FROM=text to $O from, DIR=$O direction,
+ N I,IEN,CNT S I=0,CNT=44
+ F  Q:I'<CNT  S FROM=$O(^SC("B",FROM),DIR) Q:FROM=""  D  ; IA# 10040.
+ . S IEN="" F  S IEN=$O(^SC("B",FROM,IEN),DIR) Q:'IEN  D
+ . . Q:("CW"'[$P($G(^SC(IEN,0)),U,3)!('$$ACTLOC(IEN)))
+ . . S I=I+1,Y(I)=IEN_"^"_FROM
+ Q
+NEWPERS(ORY,ORFROM,ORDIR,ORKEY,ORDATE,ORVIZ,ORALL) ; Return a set of names from the NEW PERSON file.
+ ; SLC/PKS: Code moved to ORWU1 on 12/3/2002.
+ D NP1^ORWU1
+ Q
+GBLREF(VAL,FN) ; return global reference for file number
+ S VAL="" Q:'FN
+ S VAL=$$ROOT^DILFD(+FN)
+ ; I $E($RE(VAL))="," S VAL=$E(VAL,1,$L(VAL)-1)_")"
+ ; I $E($RE(VAL))="(" S VAL=$P(VAL,"(",1) 
+ Q
+GENERIC(Y,FROM,DIR,REF) ; Return a set of entries from xref in REF
+ ; .Y=returned list, FROM=text to $O from, DIR=$O direction,
+ N I,IEN,CNT S I=0,CNT=44
+ F  Q:I'<CNT  S FROM=$O(@REF@(FROM),DIR) Q:FROM=""  D
+ . S IEN="" F  S IEN=$O(@REF@(FROM,IEN),DIR) Q:'IEN  D
+ . . S I=I+1,Y(I)=IEN_"^"_FROM
+ Q
+EXTNAME(VAL,IEN,FN) ; return external form of pointer
+ ; IEN=internal number, FN=file number
+ N REF S REF=$G(^DIC(FN,0,"GL")),VAL=""
+ I $L(REF),+IEN S VAL=$P($G(@(REF_IEN_",0)")),U)
+ Q
+PARAM(VAL,APARAM)       ; return a parameter value for a user
+ ; call assumes current user, default entities, single instance
+ S VAL=$$GET^XPAR("ALL",APARAM,1,"I")
+ Q
+DEVICE(Y,FROM,DIR) ; Return a subset of entries from the Device file
+ ; .LST(n)=IEN;Name^DisplayName^Location^RMar^PLen
+ ; FROM=text to $O from, DIR=$O direction
+ N I,IEN,CNT,SHOW,X S I=0,CNT=20
+ I FROM["<" S FROM=$RE($P($RE(FROM),"<  ",2))
+ F  Q:I'<CNT  S FROM=$O(^%ZIS(1,"B",FROM),DIR) Q:FROM=""  D
+ . S IEN=0 F  S IEN=$O(^%ZIS(1,"B",FROM,IEN)) Q:'IEN  D
+ .. N X0,X1,X90,X91,X95,XTYPE,XSTYPE,XTIME,ORA,ORPX,POP
+ .. Q:'$D(^%ZIS(1,IEN,0))  S X0=^(0),X1=$G(^(1)),X90=$G(^(90)),X91=$G(^(91)),X95=$G(^(95)),XSTYPE=$G(^("SUBTYPE")),XTIME=$G(^("TIME")),XTYPE=$G(^("TYPE"))
+ .. I $E($G(^%ZIS(2,+XSTYPE,0)))'="P" Q  ;Printers only
+ .. S X=$P(XTYPE,"^") I X'="TRM",X'="HG",X'="HFS",X'="CHAN" Q  ;Device Types
+ .. S X=X0 I ($P(X,U,2)="0")!($P(X,U,12)=2) Q  ;Queuing allowed
+ .. S X=+X90 I X,(X'>DT) Q  ;Out of Service
+ .. I XTIME]"" S ORA=$P(XTIME,"^"),ORPX=$P($H,",",2),ORPCNT=ORPX\60#60+(ORPX\3600*100),ORPX=$P(ORA,"-",2) I ORPX'<ORA&(ORPCNT'>ORPX&(ORPCNT'<ORA))!(ORPX<ORA&(ORPCNT'<ORA!(ORPCNT'>ORPX))) Q  ;Prohibited Times
+ .. S POP=0
+ .. I X95]"" S ORPX=$G(DUZ(0)) I ORPX'="@" S POP=1 F ORA=1:1:$L(ORPX) I X95[$E(ORPX,ORA) S POP=0 Q
+ .. Q:POP  ;Security check
+ .. S SHOW=$P(X0,U) I SHOW'=FROM S SHOW=FROM_"  <"_SHOW_">"
+ .. S I=I+1,Y(I)=IEN_";"_$P(X0,U)_U_SHOW_U_$P(X1,U)_U_$P(X91,U)_U_$P(X91,U,3)
+ Q
+URGENCY(Y) ; -- retrieve set values from dd for discharge summary urgency
+ N ORDD,I,X
+ D FIELD^DID(8925,.09,"","POINTER","ORDD")
+ F I=1:1 S X=$P(ORDD("POINTER"),";",I) Q:X=""   S Y(I)=$TR(X,":","^")
+ Q
+PATCH(VAL,X) ; Return 1 if patch X is installed
+ S VAL=$$PATCH^XPDUTL(X)
+ Q
+VERSION(VAL,X) ;Return version of package or namespace
+ S VAL=$$VERSION^XPDUTL(X)
+ Q
+VERSRV(VAL,X,CLVER)   ; Return server version of option name
+ S ORWCLVER=$G(CLVER)  ; leave in partition for session
+ N BADVAL,ORLST
+ D FIND^DIC(19,"",1,"X",X,1,,,,"ORLST")
+ I 'ORLST("DILIST",0) S VAL="0.0.0.0" Q
+ S VAL=ORLST("DILIST","ID",1,1)
+ S VAL=$P(VAL,"version ",2)
+ S BADVAL=0
+ I $P(VAL,".",1)="" S BADVAL=1
+ I $P(VAL,".",2)="" S BADVAL=1
+ I $P(VAL,".",3)="" S BADVAL=1
+ I $P(VAL,".",4)="" S BADVAL=1
+ I ((BADVAL)!('VAL)!(VAL="")) S VAL="0.0.0.0"
+ Q
