WEBGUTIL ; SLC/JAS - WEBVRAM VISTA UTILITIES; Nov 2, 2023@12:30 PM
;;3.0;WEB VISTA REMOTE ACCESS MANAGEMENT;**13,17**;Apr 06, 2021;Build 3
;;Per VHA Directive 6402, this routine should not be modified
;
; Reference to GETLST^XPAR - Supported by ICR 2263
; Reference to file #200 - Supported by ICR 10060
; Reference to file #8989.3 - Supported by ICR 7430
; References to XLFDT - Supported by ICR 10103
;
Q
;
VERSRV(RETDLL) ; Return server version(s) for Vitals DLL
;
; Output: Active GMRV/VITALS DLL Version(s) in array format
;
N ENTITY,ERR,PARAM,RESCNT,RESULTS,VERCNT
S VERCNT=0
S ENTITY="SYS"
S PARAM="GMV DLL VERSION"
;
D GETLST^XPAR(.RESULTS,ENTITY,PARAM,"E",.ERR)
;
; Exception checking
;
I $G(ERR,0) D Q
. S RETDLL(VERCNT)="An error has occurred."
I '$D(RESULTS) D Q
. S RETDLL(VERCNT)="No entries found."
;
; Filter out inactive results
;
F RESCNT=1:1:RESULTS D
. I $P($G(RESULTS(RESCNT)),"^",2)="YES" D
. . S VERCNT=VERCNT+1
. . S RETDLL(VERCNT)=$P($G(RESULTS(RESCNT)),"^")
;
I 'VERCNT S RETDLL(VERCNT)="No active versions." Q
;
S RETDLL(0)=VERCNT
;
Q
;
VERCDEXP(RETEXP) ; Return the expiration date for current user's Verify Code
;
; Output: Expiration of DUZ's Verify Code in standard date format
;
N EXPDATE,EXPDAYS,LASTCHG,NXTCHG
;
S EXPDAYS=$$GET1^DIQ(8989.3,1,214,"I") ; LIFETIME OF VERIFY CODE in KERNEL SYSTEM PARAMETERS file
I 'EXPDAYS S EXPDAYS=90 ; 90 is the standard default
;
S LASTCHG=$$GET1^DIQ(200,DUZ,11.2,"I") ; DATE VERIFY CODE LAST CHANGED in NEW PERSON file
;
S EXPDATE=$$HADD^XLFDT(LASTCHG,EXPDAYS)
S RETEXP=$P($$HTE^XLFDT(EXPDATE,5),"@")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWEBGUTIL 1695 printed Apr 09, 2024@21:48:30 Page 2
WEBGUTIL ; SLC/JAS - WEBVRAM VISTA UTILITIES; Nov 2, 2023@12:30 PM
+1 ;;3.0;WEB VISTA REMOTE ACCESS MANAGEMENT;**13,17**;Apr 06, 2021;Build 3
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; Reference to GETLST^XPAR - Supported by ICR 2263
+5 ; Reference to file #200 - Supported by ICR 10060
+6 ; Reference to file #8989.3 - Supported by ICR 7430
+7 ; References to XLFDT - Supported by ICR 10103
+8 ;
+9 QUIT
+10 ;
VERSRV(RETDLL) ; Return server version(s) for Vitals DLL
+1 ;
+2 ; Output: Active GMRV/VITALS DLL Version(s) in array format
+3 ;
+4 NEW ENTITY,ERR,PARAM,RESCNT,RESULTS,VERCNT
+5 SET VERCNT=0
+6 SET ENTITY="SYS"
+7 SET PARAM="GMV DLL VERSION"
+8 ;
+9 DO GETLST^XPAR(.RESULTS,ENTITY,PARAM,"E",.ERR)
+10 ;
+11 ; Exception checking
+12 ;
+13 IF $GET(ERR,0)
Begin DoDot:1
+14 SET RETDLL(VERCNT)="An error has occurred."
End DoDot:1
QUIT
+15 IF '$DATA(RESULTS)
Begin DoDot:1
+16 SET RETDLL(VERCNT)="No entries found."
End DoDot:1
QUIT
+17 ;
+18 ; Filter out inactive results
+19 ;
+20 FOR RESCNT=1:1:RESULTS
Begin DoDot:1
+21 IF $PIECE($GET(RESULTS(RESCNT)),"^",2)="YES"
Begin DoDot:2
+22 SET VERCNT=VERCNT+1
+23 SET RETDLL(VERCNT)=$PIECE($GET(RESULTS(RESCNT)),"^")
End DoDot:2
End DoDot:1
+24 ;
+25 IF 'VERCNT
SET RETDLL(VERCNT)="No active versions."
QUIT
+26 ;
+27 SET RETDLL(0)=VERCNT
+28 ;
+29 QUIT
+30 ;
VERCDEXP(RETEXP) ; Return the expiration date for current user's Verify Code
+1 ;
+2 ; Output: Expiration of DUZ's Verify Code in standard date format
+3 ;
+4 NEW EXPDATE,EXPDAYS,LASTCHG,NXTCHG
+5 ;
+6 ; LIFETIME OF VERIFY CODE in KERNEL SYSTEM PARAMETERS file
SET EXPDAYS=$$GET1^DIQ(8989.3,1,214,"I")
+7 ; 90 is the standard default
IF 'EXPDAYS
SET EXPDAYS=90
+8 ;
+9 ; DATE VERIFY CODE LAST CHANGED in NEW PERSON file
SET LASTCHG=$$GET1^DIQ(200,DUZ,11.2,"I")
+10 ;
+11 SET EXPDATE=$$HADD^XLFDT(LASTCHG,EXPDAYS)
+12 SET RETEXP=$PIECE($$HTE^XLFDT(EXPDATE,5),"@")
+13 QUIT
