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