Changeset 636 for FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUS.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUS.m (modified) (7 diffs)

FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUS.m

@@ -1 @@
-XUS ;SFISC/STAFF - SIGNON ;2/13/07  14:44
- ;;8.0;KERNEL;**16,26,49,59,149,180,265,337,419,434**;Jul 10, 1995;Build 6
+XUS ;SFISC/STAFF - SIGNON ;3/19/07  09:15
+ ;;8.0;KERNEL;**16,26,49,59,149,180,265,337,419,437**;Jul 10, 1995;Build 22
+ ; Modified from FOIA VISTA,
+ ; Copyright (C) 2007 WorldVistA
+ ;
+ ; This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU General Public License as published by
+ ; the Free Software Foundation; either version 2 of the License, or
+ ; (at your option) any later version.
+ ;
+ ; This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU General Public License for more details.
+ ;
+ ; You should have received a copy of the GNU General Public License
+ ; along with this program; if not, write to the Free Software
+ ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
  ;Sign-on message numbers are 30810.51 to 30810.99
  S U="^" D INTRO^XUS1A()
@@ -80 +96 @@
  . Q
  Q A
- ;
+ ; 
 CHECKAV(X1) ;Check A/V code return DUZ or Zero. (Called from XUSRB)
  N %,%1,X,Y,IEN,DA,DIK
@@ -90 +106 @@
  . Q
  ;End CCOW
- S X1=$$UP(X1) S:X1[":" XUTT=1,X1=$TR(X1,":")
+ S X1=$S($$GET^XPAR("SYS","XU VC CASE SENSITIVE"):$$UP($P(X1,";",1))_";"_$P(X1,";",2),1:$$UP(X1)) S:X1[":" XUTT=1,X1=$TR(X1,":") ; Allow case sensitive for VOE
  S X=$P(X1,";") Q:X="^" -1 S:XUF %1="Access: "_X
  Q:X'?1.20ANP 0
- S X=$$EN^XUSHSH(X) I '$D(^VA(200,"A",X)) D LBAV Q 0
+ S X=$$EN^XUSHSH(X) I '$D(^VA(200,"A",X)) D LBAV Q 0 ; Case insensitive for Access Code for VOE
  S %1="",IEN=$O(^VA(200,"A",X,0)),XUF(.3)=IEN D USER(IEN)
  S X=$P(X1,";",2) S:XUF %1="Verify: "_X S X=$$EN^XUSHSH(X)
@@ -121 +137 @@
  N %
  S U="^",XUEON=^%ZOSF("EON"),XUEOFF=^("EOFF")
- D XUVOL,XOPT S DUZ("LANG")=$P(XOPT,U,7) ;S:$P(XUVOL,U,6)="y" XRTL=XUCI_","_XQVOL
+ D XUVOL,XOPT S DUZ("LANG")=$P(XOPT,U,7) S:$P(XUVOL,U,6)="y" XRTL=XUCI_","_XQVOL
  K ^XUTL("XQ",$J) S XUF=0,XUDEV=0,DUZ=0,DUZ(0)="@",IOS=0,ION=""
  I FLAG S %ZIS="L",IOP="HOME" D ^%ZIS Q:POP
- S XUDEV=IOS,XUIOP=ION
+ S XUDEV=IOS,XUIOP=ION D:$D(XRTL) T0^%ZOSV
  D GETFAC^XUS3($G(IO("IP")))
  S %=$P(XOPT,U,14)
@@ -130 +146 @@
  . S XUF=(%["R")+1,XUF(.1)="",XUF(.2)=0,XUF(.3)=0
  . I %["D" S:$D(^XTV(8989.3,1,4.33,"B",XUDEV))[0 XUF=0
- S DILOCKTM=+$G(^DD("DILOCKTM"),1) ;p434 IA#4909
  Q
 SET2() ;EF. Return error code (also called from XUSRB)
@@ -142 +157 @@
  S DTIME=600
  I '$P(XOPT,U,11),$D(^%ZIS(1,XUDEV,90)),^(90)>2800000,^(90)'>DT Q 8
+ I $D(XRT0) S XRTN="XUS" D T1^%ZOSV
  Q 0
  ;
@@ -148 +164 @@
  I $P(XUSER(1.1),U,5),$P(XUSER(1.1),U,5)>XUNOW S XUM(0)=$$FMTE^XLFDT($P(XUSER(1.1),U,5),"2PM") Q 18 ;User locked until
  I $P(XUSER(0),U,11),$P(XUSER(0),U,11)'>DT Q 11 ;Access Terminated
- I $D(DUZ("ASH")) Q 0 ;If auto handle, Allow to sign-on p434
  I $P(XUSER(0),U,7) Q 5 ;Disuser flag set
- I '$L($P(XUSER(1),U,2)) Q 21 ;p419, p434
+ I '$L($P(XUSER(1),U,2)) Q 21 ;419
  Q 0
  ;