XUSAP1 ;OAK/KC - Connector Proxy Reports ;2/1/2012
;;8.0;KERNEL;**574**;Jul 10, 1995;Build 5
;Per VHA Directive 2004-038, this routine should not be modified.
Q
; Option File entry points:
; EN1^XUSAP1: prompt user to select 1 connector proxy to display
; ENALL^XUSAP1: prompt user to display all connector proxies (can be scheduled)
;
EN1 ;option entry point w/dialog to select 1 CP entry; calls task entry point
N XUSCPSAV,XUSCPDUZ,DIC,X,Y,XUSCPSCANLOG,XUSCPSCANFLD
I '$$GETCPIEN W !!,"ABORTING! 'CONNECTOR PROXY' USER CLASS UNDEFINED." Q
;select CP entry to print
S DIC="^VA(200,",DIC(0)="AEMQZ",DIC("S")="I $$ISUSERCP^XUSAP1(Y)" D ^DIC Q:Y'>0
S XUSCPDUZ=+Y,XUSCPSAV("XUSCPDUZ")=""
K Y D ASKFLD Q:Y[U!(Y="") S XUSCPSCANFLD=+Y,XUSCPSAV("XUSCPSCANFLD")=""
K Y D ASKLOG Q:Y[U!(Y="") S XUSCPSCANLOG=+Y,XUSCPSAV("XUSCPSCANLOG")=""
D EN^XUTMDEVQ("Q1^XUSAP1","Connector Proxy Display",.XUSCPSAV)
Q
;
ENALL ;schedulable option entry point w/dialog to print all CPs; calls task entry point
N XUSCPSAV,XUSCPSCANLOG,XUSCPSCANFLD
I '$$GETCPIEN W !!,"Connector Proxy Report ABORTING! 'CONNECTOR PROXY' USER CLASS UNDEFINED." Q
I $D(ZTQUEUED) S (XUSCPSCANLOG,XUSCPSCANFLD)=1 G QALL ; can run as scheduled option
K Y D ASKFLD Q:Y[U!(Y="") S XUSCPSCANFLD=+Y,XUSCPSAV("XUSCPSCANFLD")=""
K Y D ASKLOG Q:Y[U!(Y="") S XUSCPSCANLOG=+Y,XUSCPSAV("XUSCPSCANLOG")=""
D EN^XUTMDEVQ("QALL^XUSAP1","Connector Proxy Report",.XUSCPSAV)
Q
;
ASKLOG ;ask if want to scan sign-on log too
N DIR,DTOUT,DUOUT,DIRUT,DIROUT
S DIR(0)="YO",DIR("B")="No"
S DIR("A")="Scan sign-on log for connector proxy activity"
S DIR("?")="Scanning the sign-on log will consume additional time before report completion."
D ^DIR Q
;
ASKFLD ;ask if want to analyze options
N DIR,DTOUT,DUOUT,DIRUT,DIROUT
S DIR(0)="YO",DIR("B")="Yes"
S DIR("A")="Check/display connector proxy fields"
S DIR("?")="More output will be contained in the report if connector proxy fields are checked/displayed."
D ^DIR Q
;
Q1 ;EN^XUTMDEVQ entry point, print 1
;input values:
; XUSCPDUZ (conn proxy DUZ)
; XUSCPSCANFLD (whether to scan NP flds in CP entries)
; XUSCPSCANLOG (whether to scan sign-on log)
N XUSCPRNT,XUSCPDT,XUSCPSAEXP,XUSCPACTIVE,XUSCPQ,XUSCPLST,XUSCPOKFLDS,XUSCPWARNFLDS,XUSCPINACFLDS
S XUSCPACTIVE=$$ACTIVE^XUSER(XUSCPDUZ)
D VARSETUP
I +$G(XUSCPSCANLOG) S XUSCPLST($P(XUSCPACTIVE,U),XUSCPDUZ)=$P(XUSCPACTIVE,U,2) D SCANLOG
W:$E(IOST,1,2)="C-" @IOF D HDR,BLURB
D P(XUSCPACTIVE,XUSCPDUZ)
K ^TMP($J,"XUSCP"),^TMP($J,"XUSCPLOG") Q
;
QALL ;EN^XUTMDEVQ entry point, print all
;input values (EN^XUTMDEVQ):
; XUSCPSCANFLD (whether to scan NP flds in CP entries)
; XUSCPSCANLOG (whether to scan sign-on log)
N XUSCPRNT,XUSCPDT,XUSCPSAEXP,XUSCPACTIVE,XUSCPQ,XUSCPLST,XUSCPOKFLDS,XUSCPWARNFLDS,XUSCPINACFLDS
D VARSETUP
;gather DUZ list of CPs in XUSCPLST
D DUZLIST Q:+$G(ZTSTOP)
D:+$G(XUSCPSCANLOG) SCANLOG Q:+$G(ZTSTOP)
W:$E(IOST,1,2)="C-" @IOF D HDR,BLURB ;header for page 1
;loop through/sort by active, then inactive, CP DUZ list users, print detail if requested
F XUSCPACTIVE=1,0 Q:+$G(XUSCPQ) D
.S XUSCPDUZ=0 F S XUSCPDUZ=$O(XUSCPLST(XUSCPACTIVE,XUSCPDUZ)) Q:('XUSCPDUZ)!+$G(XUSCPQ) D P(XUSCPACTIVE,XUSCPDUZ)
K ^TMP($J,"XUSCP"),^TMP($J,"XUSCPLOG") Q
;
VARSETUP ;set up date,print,field list vars
S XUSCPDT=$$HTFM^XLFDT($H),XUSCPSAEXP=1095 ;current date, + service acct expiry in days
S XUSCPRNT("DT EXT")=$$FMTE^XLFDT(XUSCPDT,"1PM")
S $P(XUSCPRNT("UL"),"-",IOM)="",$P(XUSCPRNT("EQ"),"=",IOM)="",XUSCPRNT("PG")=1
D ADDFLDS("WARNFLDS",.XUSCPWARNFLDS) ;get fields processed in warning sections
D ADDFLDS("OKFLDS",.XUSCPOKFLDS) ;get "ok to be populated" field list
D ADDFLDS("INACFLDS",.XUSCPINACFLDS) ;get "ok for inactive user field list
Q
;
P(XUSCPACTIVE,XUSCPDUZ) ;print/display a CP entry
;input values: XUSCPDUZ, + VARSET values
N XUSCPERR,I,J,XUSCPSTR
I $$S^%ZTLOAD() S (XUSCPQ,ZTSTOP)=1 Q
K ^TMP($J,"XUSCP")
I $$HDRCHK(4) S XUSCPQ=1 Q
D GETS^DIQ(200,XUSCPDUZ,"**","EINR","^TMP($J,""XUSCP"")","XUSCPERR") ;get populated fields int/ext
I $D(XUSCPERR) D Q
.W !," >>>>Error(s) processing Connector Proxy DUZ "_XUSCPDUZ_": "
.S I=0 F S I=$O(XUSCPERR("DIERR",I)) Q:'I!(+$G(XUSCPQ)) D
..S J=0 F S J=$O(XUSCPERR("DIERR",I,"TEXT",J)) Q:'J!(+$G(XUSCPQ)) D
...W !," >>>>"_$G(XUSCPERR("DIERR",I))_" "_$G(XUSCPERR("DIERR",I,"TEXT",J)),!
...I $$HDRCHK(4) S XUSCPQ=1 Q
;
S XUSCPSTR="Name: '"_$$NAME^XUSER(XUSCPDUZ)_"'"
W !,XUSCPRNT("EQ"),!,XUSCPSTR,$$RJ^XLFSTR(" Active: "_$S(+XUSCPACTIVE:"YES",1:"NO"),IOM-$L(XUSCPSTR)-1," ")
I '+XUSCPACTIVE,$L($G(XUSCPLST(XUSCPACTIVE,XUSCPDUZ))) W !,$$RJ^XLFSTR("("_XUSCPLST(XUSCPACTIVE,XUSCPDUZ)_")",IOM-1," ")
W !,XUSCPRNT("EQ")
I $$HDRCHK(4) S XUSCPQ=1 Q
;
D PCREDCHK S:$$HDRCHK(4) XUSCPQ=1 Q:+$G(XUSCPQ)
I +$G(XUSCPSCANFLD) D Q:+$G(XUSCPQ)
.D PWARN S:$$HDRCHK(4) XUSCPQ=1 Q:+$G(XUSCPQ)
.D POKFLDS S:$$HDRCHK(4) XUSCPQ=1 Q:+$G(XUSCPQ)
.D PBADFLDS S:$$HDRCHK(4) XUSCPQ=1 Q:+$G(XUSCPQ)
.D PBADMULT S:$$HDRCHK(4) XUSCPQ=1 Q:+$G(XUSCPQ)
D:+$G(XUSCPSCANLOG) PSCANLOG S:$$HDRCHK(4) XUSCPQ=1 Q:+$G(XUSCPQ)
W !
Q
;
PCREDCHK ;display credential date checks
;input values: ^TMP($J,"XUSCP"), XUSCPDUZ, XUSCPDT
N XUSCPDIFFDE,XUSCPDIFFVC,XUSCPOLDTIME,XUSCPDC
S XUSCPOLDTIME="2950710.000101"
;check time since v/c last changed, WARN > 3 yrs
;if DATE VERIFY CODE LAST CHANGED="60000,1" then no date on record.
S XUSCPDC=$G(^TMP($J,"XUSCP",200,XUSCPDUZ_",","DATE VERIFY CODE LAST CHANGED","I")) S:$L(XUSCPDC) XUSCPDC=$$HTFM^XLFDT(XUSCPDC,1) ; convert $H to FM
S XUSCPDIFFDE=$$FMDIFF^XLFDT(XUSCPDT,$G(^TMP($J,"XUSCP",200,XUSCPDUZ_",","DATE ENTERED","I"),XUSCPOLDTIME))
S XUSCPDIFFVC=$$FMDIFF^XLFDT(XUSCPDT,$G(XUSCPDC,XUSCPOLDTIME))
I $$HDRCHK(4) S XUSCPQ=1 Q
W !," Compliant w/3-year Service Account Mandate? " D
.I (XUSCPDIFFDE<XUSCPSAEXP)!(XUSCPDIFFVC<XUSCPSAEXP) W "YES" Q ;one or both dates within exp
.;both dates exp, verify code date is real OR if fake, there are no VOLD nodes
.I ('($G(^TMP($J,"XUSCP",200,XUSCPDUZ_",","DATE VERIFY CODE LAST CHANGED","I"))="60000,1"))!('$D(^VA(200,XUSCPDUZ,"VOLD"))) W $S(XUSCPACTIVE:"*** NO <---- MUST FIX ***",1:"No, but user not active.") Q
.W $S(XUSCPACTIVE:"UNABLE TO DETERMINE",1:"unable to det. but not active.") Q ;fake verify code date AND VOLD nodes, so can't tell
W !," Date User Created: "_$G(^TMP($J,"XUSCP",200,XUSCPDUZ_",","DATE ENTERED","E"))
I $$HDRCHK(4) S XUSCPQ=1 Q
W !," Date Verify Code Last Changed: "
W $S('$L($G(^TMP($J,"XUSCP",200,XUSCPDUZ_",","DATE VERIFY CODE LAST CHANGED","I"))):"never",$G(^("I"))'="60000,1":$G(^("E")),$D(^VA(200,XUSCPDUZ,"VOLD")):"(changed but date not recorded)",1:"never")
; if XUS Logon Attempt Count > 0, strongly indicates verify code-related login problem(s) from 1 or more adapters
I +$G(^TMP($J,"XUSCP",200,XUSCPDUZ_",","XUS Logon Attempt Count","E")) W !," >>>Failed Logon Attempts: "_^("E")
Q
;
PWARN ;display warning for primary menus, other user classes defined, FM access code
N XUSCPWRN,XUSCPMUL
S:$L($G(^TMP($J,"XUSCP",200,XUSCPDUZ_",","PRIMARY MENU OPTION","E"))) XUSCPWRN("PRIMARY")=^("E")
S:$L($G(^TMP($J,"XUSCP",200,XUSCPDUZ_",","SSN","E"))) XUSCPWRN("SSN")="<masked>"
I $D(^TMP($J,"XUSCP",200,XUSCPDUZ_",","FILE MANAGER ACCESS CODE")) S XUSCPWRN("FILE MANAGER ACCESS CODE")=""
S XUSCPMUL="" F S XUSCPMUL=$O(^TMP($J,"XUSCP",200.07,XUSCPMUL)) Q:XUSCPMUL']"" D
.I ^TMP($J,"XUSCP",200.07,XUSCPMUL,"User Class","I")'=$$GETCPIEN S XUSCPWRN("USC")=""
I $D(XUSCPWRN) W !!," Warning(s):",!," -----------" D Q:+$G(XUSCPQ)!+$G(XUSCPQ)
.I $D(XUSCPWRN("PRIMARY")) W !," Primary Menu defined (SHOULDN'T BE!): ",XUSCPWRN("PRIMARY")
.I $D(XUSCPWRN("SSN")) W !," SSN defined (SHOULDN'T BE!): ",XUSCPWRN("SSN")
.I $$HDRCHK(4) S XUSCPQ=1 Q
.I $D(XUSCPWRN("USC")) W !," Non-CP User Classes defined (SHOULDN'T BE!): " D Q:+$G(XUSCPQ)
..S XUSCPMUL="" F S XUSCPMUL=$O(^TMP($J,"XUSCP",200.07,XUSCPMUL)) Q:XUSCPMUL']""!+$G(XUSCPQ) D
...Q:^TMP($J,"XUSCP",200.07,XUSCPMUL,"User Class","I")=$$GETCPIEN
...W !," - "_^TMP($J,"XUSCP",200.07,XUSCPMUL,"User Class","E")
...I $$HDRCHK(4) S XUSCPQ=1 Q
.I $D(XUSCPWRN("FILE MANAGER ACCESS CODE")) W !," File Manager Access Code is defined (SHOULDN'T BE!): "_^TMP($J,"XUSCP",200,XUSCPDUZ_",","FILE MANAGER ACCESS CODE","E")
Q
;
POKFLDS ;display values of allowed fields
N XUSCPFLD
W !!," Values for other fields allowed/expected to be Populated:"
W !," ----------------------------------------------------------"
I $$HDRCHK(4) S XUSCPQ=1 Q
S XUSCPFLD="" F S XUSCPFLD=$O(XUSCPOKFLDS(XUSCPFLD)) Q:'$L(XUSCPFLD)!(+$G(XUSCPQ)) D PFLD
I 'XUSCPACTIVE S XUSCPFLD="" F S XUSCPFLD=$O(XUSCPINACFLDS(XUSCPFLD)) Q:'$L(XUSCPFLD)!(+$G(XUSCPQ)) D PFLD
Q
;
PFLD ; output a field
;input XUSCPFLD,XUSCPDUZ,^TMP values
Q:'$D(^TMP($J,"XUSCP",200,XUSCPDUZ_",",XUSCPFLD,"I")) ; skip empty fields
W !," "_$$RJ^XLFSTR(XUSCPFLD,29)_": "
W $S(XUSCPFLD="NAME COMPONENTS":"entry# "_$G(^TMP($J,"XUSCP",200,XUSCPDUZ_",",XUSCPFLD,"I")),1:$G(^TMP($J,"XUSCP",200,XUSCPDUZ_",",XUSCPFLD,"E")))
I $$HDRCHK(4) S XUSCPQ=1 Q
Q
;
PBADFLDS ;display any unexpected (not part of CP template) top-level fields populated
N XUSCPFLD,XUSCPCNT
S XUSCPFLD="",XUSCPCNT=0 F S XUSCPFLD=$O(^TMP($J,"XUSCP",200,XUSCPDUZ_",",XUSCPFLD)) Q:XUSCPFLD']""!(+$G(XUSCPQ)) D
.Q:$D(XUSCPOKFLDS(XUSCPFLD))!$D(XUSCPWARNFLDS(XUSCPFLD))
.Q:$D(XUSCPINACFLDS(XUSCPFLD))&'XUSCPACTIVE
.S XUSCPCNT=XUSCPCNT+1 I XUSCPCNT=1 D Q:+$G(XUSCPQ)
..W !!," Other Fields Populated:"
..W !," -----------------------"
..I $$HDRCHK(4) S XUSCPQ=1 Q
.Q:+$G(XUSCPQ)
.D PFLD
Q
;
PBADMULT ;display any unexpected multiples; skip those already processed:
;- 200.07 user class
N XUSCPMUL,XUSCPFLD,XUSCPFILE,XUSCPCNT
S (XUSCPFILE,XUSCPCNT)=0 F S XUSCPFILE=$O(^TMP($J,"XUSCP",XUSCPFILE)) Q:'XUSCPFILE!+$G(XUSCPQ) D
.Q:XUSCPFILE=200!(XUSCPFILE="200.07")
.S XUSCPCNT=XUSCPCNT+1 D:XUSCPCNT=1
..W !!," Other Multiples Populated:"
..W !," ---------------------------"
.W !," ",XUSCPFILE,": ",$P($G(^DD(XUSCPFILE,0)),U)
.S XUSCPMUL="" F S XUSCPMUL=$O(^TMP($J,"XUSCP",XUSCPFILE,XUSCPMUL)) Q:XUSCPMUL']""!+$G(XUSCPQ) D
..S XUSCPFLD="" F S XUSCPFLD=$O(^TMP($J,"XUSCP",XUSCPFILE,XUSCPMUL,XUSCPFLD)) Q:XUSCPFLD']""!(+$G(XUSCPQ)) D
...W !," "_$$RJ^XLFSTR(XUSCPFLD,29)_": "_$G(^TMP($J,"XUSCP",XUSCPFILE,XUSCPMUL,XUSCPFLD,"E"))
...I $$HDRCHK(4) S XUSCPQ=1 Q
Q
;
PSCANLOG ; output signon activity for this CP user found in SCANLOG pass
N XUSCPIP,XUSCPSIGNON,XUSCPTOT
;input: ^TMP($J,"XUSCPLOG",XUSCPDUZ),XUSCPDUZ
W !!," Connector Proxy Activity (Sign-On Log):"
W !," --------------------------------------"
I $$HDRCHK(4) S XUSCPQ=1 Q
I '$D(^TMP($J,"XUSCPLOG",XUSCPDUZ)) W !," no signon activity found" Q
S XUSCPIP="" F S XUSCPIP=$O(^TMP($J,"XUSCPLOG",XUSCPDUZ,XUSCPIP)) Q:'+XUSCPIP!+$G(XUSCPQ) D
.W !," IP address "_XUSCPIP_": "
.W !," - Total active connections (current): ",+$G(^TMP($J,"XUSCPLOG",XUSCPDUZ,XUSCPIP,"CUR"))
.I $$HDRCHK(4) S XUSCPQ=1 Q
.S (XUSCPSIGNON,XUSCPTOT)=0 F S XUSCPSIGNON=$O(^TMP($J,"XUSCPLOG",XUSCPDUZ,XUSCPIP,XUSCPSIGNON)) Q:'+XUSCPSIGNON!+$G(XUSCPQ) D
..S XUSCPTOT=XUSCPTOT+$G(^TMP($J,"XUSCPLOG",XUSCPDUZ,XUSCPIP,XUSCPSIGNON))
.W !," - Total logons recorded in sign-on log: "_XUSCPTOT
.W !," - Total logons by date: "
.I $$HDRCHK(4) S XUSCPQ=1 Q
.S XUSCPSIGNON=0 F S XUSCPSIGNON=$O(^TMP($J,"XUSCPLOG",XUSCPDUZ,XUSCPIP,XUSCPSIGNON)) Q:'+XUSCPSIGNON!+$G(XUSCPQ) D
..W !," > "_$$FMTE^XLFDT(XUSCPSIGNON)_": "_^TMP($J,"XUSCPLOG",XUSCPDUZ,XUSCPIP,XUSCPSIGNON)
..I $$HDRCHK(4) S XUSCPQ=1 Q
Q
;
DUZLIST ;loop thru file 200, return list of CP user class DUZs in XUSCPLST in format:
;XUSCPLST(0 or 1,DUZ)=reason/description active/inactive
;0=inactive user, 1=active
N XUSCPIEN,XUSCPACTIVE,XUSCPLOOPC,XUSCPQC
;get CP user class IEN
S XUSCPIEN=$$GETCPIEN I 'XUSCPIEN W !!,"ABORTING! 'CONNECTOR PROXY' USER CLASS UNDEFINED." Q
;loop thru 200 for connector proxy users (USC3 xref)
S XUSCPQC=100
S (XUSCPDUZ,XUSCPLOOPC)=0 F S XUSCPDUZ=$O(^VA(200,XUSCPDUZ)) Q:'XUSCPDUZ!+$G(XUSCPQ) D
.S XUSCPLOOPC=XUSCPLOOPC+1 I '+(XUSCPLOOPC#XUSCPQC) I $$S^%ZTLOAD() S (XUSCPQ,ZTSTOP)=1 Q
.I $D(^VA(200,XUSCPDUZ,"USC3")) D
..Q:'$$ISUSERCP(XUSCPDUZ)
..S XUSCPACTIVE=$$ACTIVE^XUSER(XUSCPDUZ)
..S XUSCPLST($P(XUSCPACTIVE,U),XUSCPDUZ)=$P(XUSCPACTIVE,U,2)
Q
;
ISUSERCP(XUSCPDUZ) ;return 1 if any of DUZ's user classes are CP, 0 if not
N XUSCP200P07IEN,XUSCP201IEN,XUSCPRET,XUSCPIEN
S XUSCPRET=0
I $D(^VA(200,XUSCPDUZ,"USC3")) D
.;loop thru DUZ's user class multiple/look for CP
.S XUSCP200P07IEN=0,XUSCPIEN=$$GETCPIEN
.F S XUSCP200P07IEN=$O(^VA(200,XUSCPDUZ,"USC3",XUSCP200P07IEN)) Q:'XUSCP200P07IEN!$D(XUSCPLST(XUSCPDUZ)) D
..;get IEN of user class, check if CONNECTOR PROXY
..S XUSCP201IEN=$P(^VA(200,XUSCPDUZ,"USC3",XUSCP200P07IEN,0),U)
..S:(XUSCP201IEN=XUSCPIEN) XUSCPRET=1 ;user has CP user class
Q XUSCPRET
;
GETCPIEN() ;return CP IEN from User Class file
Q +$O(^VA(201,"B","CONNECTOR PROXY",""))
;
HDR ;
W "CONNECTOR PROXY REPORT: ",XUSCPRNT("DT EXT"),?70,$$RJ^XLFSTR("PAGE "_XUSCPRNT("PG"),9),!,XUSCPRNT("UL"),!
Q
;
BLURB ;
W !,">>>Always contact the National Help Desk or Customer Support, to determine"
W !,"the best fix (and be alerted to known issues) for ANY problem listed below.",!
W !?10,"Coordinate all account changes with affected remote"
W !?15,"application to prevent service disruptions.",!
Q
;
HDRCHK(Y) ;Y=excess lines, return 1 to exit
;return 0 to continue
Q:+$G(XUSCPQ) 1
Q:$Y<(IOSL-Y) 0
I $E(IOST,1,2)="C-" D Q:'Y 1
.N DIR,I,J,K,X
.S DIR(0)="E" D ^DIR
S XUSCPRNT("PG")=XUSCPRNT("PG")+1
W @IOF D HDR
Q 0
;
SCANLOG ;loop thru sign-on log for connector proxy activity, save results in ^TMP($J,"XUSCPLOG")
N XUSCPSEC0,XUSCPSIGNON,XUSCPSECDUZ,XUSCPIP,XUSCPCUR,XUSCPLOOPC,XUSCPQ,XUSCPQC
;input: XUSCPLST(ACTIVE,DUZ) list of CPs
;search each ^XUSEC(0, date/time) 0-node
SET (XUSCPSIGNON,XUSCPLOOPC)=0,XUSCPQC=100
F SET XUSCPSIGNON=$O(^XUSEC(0,XUSCPSIGNON)) Q:'+XUSCPSIGNON!+$G(XUSCPQ) D
.S XUSCPLOOPC=XUSCPLOOPC+1 I '+(XUSCPLOOPC#XUSCPQC) I $$S^%ZTLOAD() S (XUSCPQ,ZTSTOP)=1 Q
.S XUSCPSEC0=^XUSEC(0,XUSCPSIGNON,0),XUSCPSECDUZ=$P(XUSCPSEC0,U) ; get XUSEC 0 node, DUZ
.I +XUSCPSECDUZ,($D(XUSCPLST(0,XUSCPSECDUZ))!$D(XUSCPLST(1,XUSCPSECDUZ))) D ; check if DUZ in CP list
..S XUSCPIP=$P(XUSCPSEC0,U,11) S:XUSCPIP']"" XUSCPIP="unknown" ; get IP from XUSEC
..S XUSCPCUR=$D(^XUSEC(0,"CUR",XUSCPSECDUZ,XUSCPDT)) ; check if job currently logged on
..;increment logon count per IP per day
..S ^TMP($J,"XUSCPLOG",XUSCPSECDUZ,XUSCPIP,$P(XUSCPSIGNON,"."))=+$G(^TMP($J,"XUSCPLOG",XUSCPSECDUZ,XUSCPIP,$P(XUSCPSIGNON,".")))+1
..I $D(^XUSEC(0,"CUR",XUSCPSECDUZ,XUSCPSIGNON)) D ;increment currently signed on count
...S ^TMP($J,"XUSCPLOG",XUSCPSECDUZ,XUSCPIP,"CUR")=+$G(^TMP($J,"XUSCPLOG",XUSCPSECDUZ,XUSCPIP,"CUR"))+1
Q
;
ADDFLDS(XUSCPTAG,XUSCPARR) ;return list of fields in .XUSCPARR(fieldname)
; XUSCPTAG: tag to read field names from
; .XUSCPARR: array to populate (pass as .param)
N I,XUSCPFLD
F I=1:1 S XUSCPFLD=$P($T(@XUSCPTAG+I),";;",2) Q:'$L(XUSCPFLD) D
.S XUSCPARR(XUSCPFLD)=""
Q
;
OKFLDS ;top-level fields OK/expected to be populated
;;ACCESS CODE
;;CREATOR
;;DISUSER
;;Entry Last Edit Date
;;LAST SIGN-ON DATE/TIME
;;MULTIPLE SIGN-ON
;;NAME
;;NAME COMPONENTS
;;PROVIDER KEY
;;SERVICE/SECTION
;;SIGNATURE BLOCK PRINTED NAME
;;TIMESTAMP
;;VERIFY CODE
;;VERIFY CODE never expires
;;XUS Active User
;
INACFLDS ;fields OK to populate for an INACTIVE user
;;TERMINATION DATE
;
WARNFLDS ;field checked in WARNING section
;;DATE ACCESS CODE LAST CHANGED
;;DATE VERIFY CODE LAST CHANGED
;;DATE ENTERED
;;FILE MANAGER ACCESS CODE
;;SSN
;;XUS Logon Attempt Count
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSAP1 16035 printed Dec 13, 2024@02:12:06 Page 2
XUSAP1 ;OAK/KC - Connector Proxy Reports ;2/1/2012
+1 ;;8.0;KERNEL;**574**;Jul 10, 1995;Build 5
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ; Option File entry points:
+5 ; EN1^XUSAP1: prompt user to select 1 connector proxy to display
+6 ; ENALL^XUSAP1: prompt user to display all connector proxies (can be scheduled)
+7 ;
EN1 ;option entry point w/dialog to select 1 CP entry; calls task entry point
+1 NEW XUSCPSAV,XUSCPDUZ,DIC,X,Y,XUSCPSCANLOG,XUSCPSCANFLD
+2 IF '$$GETCPIEN
WRITE !!,"ABORTING! 'CONNECTOR PROXY' USER CLASS UNDEFINED."
QUIT
+3 ;select CP entry to print
+4 SET DIC="^VA(200,"
SET DIC(0)="AEMQZ"
SET DIC("S")="I $$ISUSERCP^XUSAP1(Y)"
DO ^DIC
if Y'>0
QUIT
+5 SET XUSCPDUZ=+Y
SET XUSCPSAV("XUSCPDUZ")=""
+6 KILL Y
DO ASKFLD
if Y[U!(Y="")
QUIT
SET XUSCPSCANFLD=+Y
SET XUSCPSAV("XUSCPSCANFLD")=""
+7 KILL Y
DO ASKLOG
if Y[U!(Y="")
QUIT
SET XUSCPSCANLOG=+Y
SET XUSCPSAV("XUSCPSCANLOG")=""
+8 DO EN^XUTMDEVQ("Q1^XUSAP1","Connector Proxy Display",.XUSCPSAV)
+9 QUIT
+10 ;
ENALL ;schedulable option entry point w/dialog to print all CPs; calls task entry point
+1 NEW XUSCPSAV,XUSCPSCANLOG,XUSCPSCANFLD
+2 IF '$$GETCPIEN
WRITE !!,"Connector Proxy Report ABORTING! 'CONNECTOR PROXY' USER CLASS UNDEFINED."
QUIT
+3 ; can run as scheduled option
IF $DATA(ZTQUEUED)
SET (XUSCPSCANLOG,XUSCPSCANFLD)=1
GOTO QALL
+4 KILL Y
DO ASKFLD
if Y[U!(Y="")
QUIT
SET XUSCPSCANFLD=+Y
SET XUSCPSAV("XUSCPSCANFLD")=""
+5 KILL Y
DO ASKLOG
if Y[U!(Y="")
QUIT
SET XUSCPSCANLOG=+Y
SET XUSCPSAV("XUSCPSCANLOG")=""
+6 DO EN^XUTMDEVQ("QALL^XUSAP1","Connector Proxy Report",.XUSCPSAV)
+7 QUIT
+8 ;
ASKLOG ;ask if want to scan sign-on log too
+1 NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT
+2 SET DIR(0)="YO"
SET DIR("B")="No"
+3 SET DIR("A")="Scan sign-on log for connector proxy activity"
+4 SET DIR("?")="Scanning the sign-on log will consume additional time before report completion."
+5 DO ^DIR
QUIT
+6 ;
ASKFLD ;ask if want to analyze options
+1 NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT
+2 SET DIR(0)="YO"
SET DIR("B")="Yes"
+3 SET DIR("A")="Check/display connector proxy fields"
+4 SET DIR("?")="More output will be contained in the report if connector proxy fields are checked/displayed."
+5 DO ^DIR
QUIT
+6 ;
Q1 ;EN^XUTMDEVQ entry point, print 1
+1 ;input values:
+2 ; XUSCPDUZ (conn proxy DUZ)
+3 ; XUSCPSCANFLD (whether to scan NP flds in CP entries)
+4 ; XUSCPSCANLOG (whether to scan sign-on log)
+5 NEW XUSCPRNT,XUSCPDT,XUSCPSAEXP,XUSCPACTIVE,XUSCPQ,XUSCPLST,XUSCPOKFLDS,XUSCPWARNFLDS,XUSCPINACFLDS
+6 SET XUSCPACTIVE=$$ACTIVE^XUSER(XUSCPDUZ)
+7 DO VARSETUP
+8 IF +$GET(XUSCPSCANLOG)
SET XUSCPLST($PIECE(XUSCPACTIVE,U),XUSCPDUZ)=$PIECE(XUSCPACTIVE,U,2)
DO SCANLOG
+9 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
DO HDR
DO BLURB
+10 DO P(XUSCPACTIVE,XUSCPDUZ)
+11 KILL ^TMP($JOB,"XUSCP"),^TMP($JOB,"XUSCPLOG")
QUIT
+12 ;
QALL ;EN^XUTMDEVQ entry point, print all
+1 ;input values (EN^XUTMDEVQ):
+2 ; XUSCPSCANFLD (whether to scan NP flds in CP entries)
+3 ; XUSCPSCANLOG (whether to scan sign-on log)
+4 NEW XUSCPRNT,XUSCPDT,XUSCPSAEXP,XUSCPACTIVE,XUSCPQ,XUSCPLST,XUSCPOKFLDS,XUSCPWARNFLDS,XUSCPINACFLDS
+5 DO VARSETUP
+6 ;gather DUZ list of CPs in XUSCPLST
+7 DO DUZLIST
if +$GET(ZTSTOP)
QUIT
+8 if +$GET(XUSCPSCANLOG)
DO SCANLOG
if +$GET(ZTSTOP)
QUIT
+9 ;header for page 1
if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
DO HDR
DO BLURB
+10 ;loop through/sort by active, then inactive, CP DUZ list users, print detail if requested
+11 FOR XUSCPACTIVE=1,0
if +$GET(XUSCPQ)
QUIT
Begin DoDot:1
+12 SET XUSCPDUZ=0
FOR
SET XUSCPDUZ=$ORDER(XUSCPLST(XUSCPACTIVE,XUSCPDUZ))
if ('XUSCPDUZ)!+$GET(XUSCPQ)
QUIT
DO P(XUSCPACTIVE,XUSCPDUZ)
End DoDot:1
+13 KILL ^TMP($JOB,"XUSCP"),^TMP($JOB,"XUSCPLOG")
QUIT
+14 ;
VARSETUP ;set up date,print,field list vars
+1 ;current date, + service acct expiry in days
SET XUSCPDT=$$HTFM^XLFDT($HOROLOG)
SET XUSCPSAEXP=1095
+2 SET XUSCPRNT("DT EXT")=$$FMTE^XLFDT(XUSCPDT,"1PM")
+3 SET $PIECE(XUSCPRNT("UL"),"-",IOM)=""
SET $PIECE(XUSCPRNT("EQ"),"=",IOM)=""
SET XUSCPRNT("PG")=1
+4 ;get fields processed in warning sections
DO ADDFLDS("WARNFLDS",.XUSCPWARNFLDS)
+5 ;get "ok to be populated" field list
DO ADDFLDS("OKFLDS",.XUSCPOKFLDS)
+6 ;get "ok for inactive user field list
DO ADDFLDS("INACFLDS",.XUSCPINACFLDS)
+7 QUIT
+8 ;
P(XUSCPACTIVE,XUSCPDUZ) ;print/display a CP entry
+1 ;input values: XUSCPDUZ, + VARSET values
+2 NEW XUSCPERR,I,J,XUSCPSTR
+3 IF $$S^%ZTLOAD()
SET (XUSCPQ,ZTSTOP)=1
QUIT
+4 KILL ^TMP($JOB,"XUSCP")
+5 IF $$HDRCHK(4)
SET XUSCPQ=1
QUIT
+6 ;get populated fields int/ext
DO GETS^DIQ(200,XUSCPDUZ,"**","EINR","^TMP($J,""XUSCP"")","XUSCPERR")
+7 IF $DATA(XUSCPERR)
Begin DoDot:1
+8 WRITE !," >>>>Error(s) processing Connector Proxy DUZ "_XUSCPDUZ_": "
+9 SET I=0
FOR
SET I=$ORDER(XUSCPERR("DIERR",I))
if 'I!(+$GET(XUSCPQ))
QUIT
Begin DoDot:2
+10 SET J=0
FOR
SET J=$ORDER(XUSCPERR("DIERR",I,"TEXT",J))
if 'J!(+$GET(XUSCPQ))
QUIT
Begin DoDot:3
+11 WRITE !," >>>>"_$GET(XUSCPERR("DIERR",I))_" "_$GET(XUSCPERR("DIERR",I,"TEXT",J)),!
+12 IF $$HDRCHK(4)
SET XUSCPQ=1
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+13 ;
+14 SET XUSCPSTR="Name: '"_$$NAME^XUSER(XUSCPDUZ)_"'"
+15 WRITE !,XUSCPRNT("EQ"),!,XUSCPSTR,$$RJ^XLFSTR(" Active: "_$SELECT(+XUSCPACTIVE:"YES",1:"NO"),IOM-$LENGTH(XUSCPSTR)-1," ")
+16 IF '+XUSCPACTIVE
IF $LENGTH($GET(XUSCPLST(XUSCPACTIVE,XUSCPDUZ)))
WRITE !,$$RJ^XLFSTR("("_XUSCPLST(XUSCPACTIVE,XUSCPDUZ)_")",IOM-1," ")
+17 WRITE !,XUSCPRNT("EQ")
+18 IF $$HDRCHK(4)
SET XUSCPQ=1
QUIT
+19 ;
+20 DO PCREDCHK
if $$HDRCHK(4)
SET XUSCPQ=1
if +$GET(XUSCPQ)
QUIT
+21 IF +$GET(XUSCPSCANFLD)
Begin DoDot:1
+22 DO PWARN
if $$HDRCHK(4)
SET XUSCPQ=1
if +$GET(XUSCPQ)
QUIT
+23 DO POKFLDS
if $$HDRCHK(4)
SET XUSCPQ=1
if +$GET(XUSCPQ)
QUIT
+24 DO PBADFLDS
if $$HDRCHK(4)
SET XUSCPQ=1
if +$GET(XUSCPQ)
QUIT
+25 DO PBADMULT
if $$HDRCHK(4)
SET XUSCPQ=1
if +$GET(XUSCPQ)
QUIT
End DoDot:1
if +$GET(XUSCPQ)
QUIT
+26 if +$GET(XUSCPSCANLOG)
DO PSCANLOG
if $$HDRCHK(4)
SET XUSCPQ=1
if +$GET(XUSCPQ)
QUIT
+27 WRITE !
+28 QUIT
+29 ;
PCREDCHK ;display credential date checks
+1 ;input values: ^TMP($J,"XUSCP"), XUSCPDUZ, XUSCPDT
+2 NEW XUSCPDIFFDE,XUSCPDIFFVC,XUSCPOLDTIME,XUSCPDC
+3 SET XUSCPOLDTIME="2950710.000101"
+4 ;check time since v/c last changed, WARN > 3 yrs
+5 ;if DATE VERIFY CODE LAST CHANGED="60000,1" then no date on record.
+6 ; convert $H to FM
SET XUSCPDC=$GET(^TMP($JOB,"XUSCP",200,XUSCPDUZ_",","DATE VERIFY CODE LAST CHANGED","I"))
if $LENGTH(XUSCPDC)
SET XUSCPDC=$$HTFM^XLFDT(XUSCPDC,1)
+7 SET XUSCPDIFFDE=$$FMDIFF^XLFDT(XUSCPDT,$GET(^TMP($JOB,"XUSCP",200,XUSCPDUZ_",","DATE ENTERED","I"),XUSCPOLDTIME))
+8 SET XUSCPDIFFVC=$$FMDIFF^XLFDT(XUSCPDT,$GET(XUSCPDC,XUSCPOLDTIME))
+9 IF $$HDRCHK(4)
SET XUSCPQ=1
QUIT
+10 WRITE !," Compliant w/3-year Service Account Mandate? "
Begin DoDot:1
+11 ;one or both dates within exp
IF (XUSCPDIFFDE<XUSCPSAEXP)!(XUSCPDIFFVC<XUSCPSAEXP)
WRITE "YES"
QUIT
+12 ;both dates exp, verify code date is real OR if fake, there are no VOLD nodes
+13 IF ('($GET(^TMP($JOB,"XUSCP",200,XUSCPDUZ_",","DATE VERIFY CODE LAST CHANGED","I"))="60000,1"))!('$DATA(^VA(200,XUSCPDUZ,"VOLD")))
WRITE $SELECT(XUSCPACTIVE:"*** NO <---- MUST FIX ***",1:"No, but user not active.")
QUIT
+14 ;fake verify code date AND VOLD nodes, so can't tell
WRITE $SELECT(XUSCPACTIVE:"UNABLE TO DETERMINE",1:"unable to det. but not active.")
QUIT
End DoDot:1
+15 WRITE !," Date User Created: "_$GET(^TMP($JOB,"XUSCP",200,XUSCPDUZ_",","DATE ENTERED","E"))
+16 IF $$HDRCHK(4)
SET XUSCPQ=1
QUIT
+17 WRITE !," Date Verify Code Last Changed: "
+18 WRITE $SELECT('$LENGTH($GET(^TMP($JOB,"XUSCP",200,XUSCPDUZ_",","DATE VERIFY CODE LAST CHANGED","I"))):"never",$GET(^("I"))'="60000,1":$GET(^("E")),$DATA(^VA(200,XUSCPDUZ,"VOLD")):"(changed but date not recorded)",1:"never")
+19 ; if XUS Logon Attempt Count > 0, strongly indicates verify code-related login problem(s) from 1 or more adapters
+20 IF +$GET(^TMP($JOB,"XUSCP",200,XUSCPDUZ_",","XUS Logon Attempt Count","E"))
WRITE !," >>>Failed Logon Attempts: "_^("E")
+21 QUIT
+22 ;
PWARN ;display warning for primary menus, other user classes defined, FM access code
+1 NEW XUSCPWRN,XUSCPMUL
+2 if $LENGTH($GET(^TMP($JOB,"XUSCP",200,XUSCPDUZ_",","PRIMARY MENU OPTION","E")))
SET XUSCPWRN("PRIMARY")=^("E")
+3 if $LENGTH($GET(^TMP($JOB,"XUSCP",200,XUSCPDUZ_",","SSN","E")))
SET XUSCPWRN("SSN")="<masked>"
+4 IF $DATA(^TMP($JOB,"XUSCP",200,XUSCPDUZ_",","FILE MANAGER ACCESS CODE"))
SET XUSCPWRN("FILE MANAGER ACCESS CODE")=""
+5 SET XUSCPMUL=""
FOR
SET XUSCPMUL=$ORDER(^TMP($JOB,"XUSCP",200.07,XUSCPMUL))
if XUSCPMUL']""
QUIT
Begin DoDot:1
+6 IF ^TMP($JOB,"XUSCP",200.07,XUSCPMUL,"User Class","I")'=$$GETCPIEN
SET XUSCPWRN("USC")=""
End DoDot:1
+7 IF $DATA(XUSCPWRN)
WRITE !!," Warning(s):",!," -----------"
Begin DoDot:1
+8 IF $DATA(XUSCPWRN("PRIMARY"))
WRITE !," Primary Menu defined (SHOULDN'T BE!): ",XUSCPWRN("PRIMARY")
+9 IF $DATA(XUSCPWRN("SSN"))
WRITE !," SSN defined (SHOULDN'T BE!): ",XUSCPWRN("SSN")
+10 IF $$HDRCHK(4)
SET XUSCPQ=1
QUIT
+11 IF $DATA(XUSCPWRN("USC"))
WRITE !," Non-CP User Classes defined (SHOULDN'T BE!): "
Begin DoDot:2
+12 SET XUSCPMUL=""
FOR
SET XUSCPMUL=$ORDER(^TMP($JOB,"XUSCP",200.07,XUSCPMUL))
if XUSCPMUL']""!+$GET(XUSCPQ)
QUIT
Begin DoDot:3
+13 if ^TMP($JOB,"XUSCP",200.07,XUSCPMUL,"User Class","I")=$$GETCPIEN
QUIT
+14 WRITE !," - "_^TMP($JOB,"XUSCP",200.07,XUSCPMUL,"User Class","E")
+15 IF $$HDRCHK(4)
SET XUSCPQ=1
QUIT
End DoDot:3
End DoDot:2
if +$GET(XUSCPQ)
QUIT
+16 IF $DATA(XUSCPWRN("FILE MANAGER ACCESS CODE"))
WRITE !," File Manager Access Code is defined (SHOULDN'T BE!): "_^TMP($JOB,"XUSCP",200,XUSCPDUZ_",","FILE MANAGER ACCESS CODE","E")
End DoDot:1
if +$GET(XUSCPQ)!+$GET(XUSCPQ)
QUIT
+17 QUIT
+18 ;
POKFLDS ;display values of allowed fields
+1 NEW XUSCPFLD
+2 WRITE !!," Values for other fields allowed/expected to be Populated:"
+3 WRITE !," ----------------------------------------------------------"
+4 IF $$HDRCHK(4)
SET XUSCPQ=1
QUIT
+5 SET XUSCPFLD=""
FOR
SET XUSCPFLD=$ORDER(XUSCPOKFLDS(XUSCPFLD))
if '$LENGTH(XUSCPFLD)!(+$GET(XUSCPQ))
QUIT
DO PFLD
+6 IF 'XUSCPACTIVE
SET XUSCPFLD=""
FOR
SET XUSCPFLD=$ORDER(XUSCPINACFLDS(XUSCPFLD))
if '$LENGTH(XUSCPFLD)!(+$GET(XUSCPQ))
QUIT
DO PFLD
+7 QUIT
+8 ;
PFLD ; output a field
+1 ;input XUSCPFLD,XUSCPDUZ,^TMP values
+2 ; skip empty fields
if '$DATA(^TMP($JOB,"XUSCP",200,XUSCPDUZ_",",XUSCPFLD,"I"))
QUIT
+3 WRITE !," "_$$RJ^XLFSTR(XUSCPFLD,29)_": "
+4 WRITE $SELECT(XUSCPFLD="NAME COMPONENTS":"entry# "_$GET(^TMP($JOB,"XUSCP",200,XUSCPDUZ_",",XUSCPFLD,"I")),1:$GET(^TMP($JOB,"XUSCP",200,XUSCPDUZ_",",XUSCPFLD,"E")))
+5 IF $$HDRCHK(4)
SET XUSCPQ=1
QUIT
+6 QUIT
+7 ;
PBADFLDS ;display any unexpected (not part of CP template) top-level fields populated
+1 NEW XUSCPFLD,XUSCPCNT
+2 SET XUSCPFLD=""
SET XUSCPCNT=0
FOR
SET XUSCPFLD=$ORDER(^TMP($JOB,"XUSCP",200,XUSCPDUZ_",",XUSCPFLD))
if XUSCPFLD']""!(+$GET(XUSCPQ))
QUIT
Begin DoDot:1
+3 if $DATA(XUSCPOKFLDS(XUSCPFLD))!$DATA(XUSCPWARNFLDS(XUSCPFLD))
QUIT
+4 if $DATA(XUSCPINACFLDS(XUSCPFLD))&'XUSCPACTIVE
QUIT
+5 SET XUSCPCNT=XUSCPCNT+1
IF XUSCPCNT=1
Begin DoDot:2
+6 WRITE !!," Other Fields Populated:"
+7 WRITE !," -----------------------"
+8 IF $$HDRCHK(4)
SET XUSCPQ=1
QUIT
End DoDot:2
if +$GET(XUSCPQ)
QUIT
+9 if +$GET(XUSCPQ)
QUIT
+10 DO PFLD
End DoDot:1
+11 QUIT
+12 ;
PBADMULT ;display any unexpected multiples; skip those already processed:
+1 ;- 200.07 user class
+2 NEW XUSCPMUL,XUSCPFLD,XUSCPFILE,XUSCPCNT
+3 SET (XUSCPFILE,XUSCPCNT)=0
FOR
SET XUSCPFILE=$ORDER(^TMP($JOB,"XUSCP",XUSCPFILE))
if 'XUSCPFILE!+$GET(XUSCPQ)
QUIT
Begin DoDot:1
+4 if XUSCPFILE=200!(XUSCPFILE="200.07")
QUIT
+5 SET XUSCPCNT=XUSCPCNT+1
if XUSCPCNT=1
Begin DoDot:2
+6 WRITE !!," Other Multiples Populated:"
+7 WRITE !," ---------------------------"
End DoDot:2
+8 WRITE !," ",XUSCPFILE,": ",$PIECE($GET(^DD(XUSCPFILE,0)),U)
+9 SET XUSCPMUL=""
FOR
SET XUSCPMUL=$ORDER(^TMP($JOB,"XUSCP",XUSCPFILE,XUSCPMUL))
if XUSCPMUL']""!+$GET(XUSCPQ)
QUIT
Begin DoDot:2
+10 SET XUSCPFLD=""
FOR
SET XUSCPFLD=$ORDER(^TMP($JOB,"XUSCP",XUSCPFILE,XUSCPMUL,XUSCPFLD))
if XUSCPFLD']""!(+$GET(XUSCPQ))
QUIT
Begin DoDot:3
+11 WRITE !," "_$$RJ^XLFSTR(XUSCPFLD,29)_": "_$GET(^TMP($JOB,"XUSCP",XUSCPFILE,XUSCPMUL,XUSCPFLD,"E"))
+12 IF $$HDRCHK(4)
SET XUSCPQ=1
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
PSCANLOG ; output signon activity for this CP user found in SCANLOG pass
+1 NEW XUSCPIP,XUSCPSIGNON,XUSCPTOT
+2 ;input: ^TMP($J,"XUSCPLOG",XUSCPDUZ),XUSCPDUZ
+3 WRITE !!," Connector Proxy Activity (Sign-On Log):"
+4 WRITE !," --------------------------------------"
+5 IF $$HDRCHK(4)
SET XUSCPQ=1
QUIT
+6 IF '$DATA(^TMP($JOB,"XUSCPLOG",XUSCPDUZ))
WRITE !," no signon activity found"
QUIT
+7 SET XUSCPIP=""
FOR
SET XUSCPIP=$ORDER(^TMP($JOB,"XUSCPLOG",XUSCPDUZ,XUSCPIP))
if '+XUSCPIP!+$GET(XUSCPQ)
QUIT
Begin DoDot:1
+8 WRITE !," IP address "_XUSCPIP_": "
+9 WRITE !," - Total active connections (current): ",+$GET(^TMP($JOB,"XUSCPLOG",XUSCPDUZ,XUSCPIP,"CUR"))
+10 IF $$HDRCHK(4)
SET XUSCPQ=1
QUIT
+11 SET (XUSCPSIGNON,XUSCPTOT)=0
FOR
SET XUSCPSIGNON=$ORDER(^TMP($JOB,"XUSCPLOG",XUSCPDUZ,XUSCPIP,XUSCPSIGNON))
if '+XUSCPSIGNON!+$GET(XUSCPQ)
QUIT
Begin DoDot:2
+12 SET XUSCPTOT=XUSCPTOT+$GET(^TMP($JOB,"XUSCPLOG",XUSCPDUZ,XUSCPIP,XUSCPSIGNON))
End DoDot:2
+13 WRITE !," - Total logons recorded in sign-on log: "_XUSCPTOT
+14 WRITE !," - Total logons by date: "
+15 IF $$HDRCHK(4)
SET XUSCPQ=1
QUIT
+16 SET XUSCPSIGNON=0
FOR
SET XUSCPSIGNON=$ORDER(^TMP($JOB,"XUSCPLOG",XUSCPDUZ,XUSCPIP,XUSCPSIGNON))
if '+XUSCPSIGNON!+$GET(XUSCPQ)
QUIT
Begin DoDot:2
+17 WRITE !," > "_$$FMTE^XLFDT(XUSCPSIGNON)_": "_^TMP($JOB,"XUSCPLOG",XUSCPDUZ,XUSCPIP,XUSCPSIGNON)
+18 IF $$HDRCHK(4)
SET XUSCPQ=1
QUIT
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
DUZLIST ;loop thru file 200, return list of CP user class DUZs in XUSCPLST in format:
+1 ;XUSCPLST(0 or 1,DUZ)=reason/description active/inactive
+2 ;0=inactive user, 1=active
+3 NEW XUSCPIEN,XUSCPACTIVE,XUSCPLOOPC,XUSCPQC
+4 ;get CP user class IEN
+5 SET XUSCPIEN=$$GETCPIEN
IF 'XUSCPIEN
WRITE !!,"ABORTING! 'CONNECTOR PROXY' USER CLASS UNDEFINED."
QUIT
+6 ;loop thru 200 for connector proxy users (USC3 xref)
+7 SET XUSCPQC=100
+8 SET (XUSCPDUZ,XUSCPLOOPC)=0
FOR
SET XUSCPDUZ=$ORDER(^VA(200,XUSCPDUZ))
if 'XUSCPDUZ!+$GET(XUSCPQ)
QUIT
Begin DoDot:1
+9 SET XUSCPLOOPC=XUSCPLOOPC+1
IF '+(XUSCPLOOPC#XUSCPQC)
IF $$S^%ZTLOAD()
SET (XUSCPQ,ZTSTOP)=1
QUIT
+10 IF $DATA(^VA(200,XUSCPDUZ,"USC3"))
Begin DoDot:2
+11 if '$$ISUSERCP(XUSCPDUZ)
QUIT
+12 SET XUSCPACTIVE=$$ACTIVE^XUSER(XUSCPDUZ)
+13 SET XUSCPLST($PIECE(XUSCPACTIVE,U),XUSCPDUZ)=$PIECE(XUSCPACTIVE,U,2)
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
ISUSERCP(XUSCPDUZ) ;return 1 if any of DUZ's user classes are CP, 0 if not
+1 NEW XUSCP200P07IEN,XUSCP201IEN,XUSCPRET,XUSCPIEN
+2 SET XUSCPRET=0
+3 IF $DATA(^VA(200,XUSCPDUZ,"USC3"))
Begin DoDot:1
+4 ;loop thru DUZ's user class multiple/look for CP
+5 SET XUSCP200P07IEN=0
SET XUSCPIEN=$$GETCPIEN
+6 FOR
SET XUSCP200P07IEN=$ORDER(^VA(200,XUSCPDUZ,"USC3",XUSCP200P07IEN))
if 'XUSCP200P07IEN!$DATA(XUSCPLST(XUSCPDUZ))
QUIT
Begin DoDot:2
+7 ;get IEN of user class, check if CONNECTOR PROXY
+8 SET XUSCP201IEN=$PIECE(^VA(200,XUSCPDUZ,"USC3",XUSCP200P07IEN,0),U)
+9 ;user has CP user class
if (XUSCP201IEN=XUSCPIEN)
SET XUSCPRET=1
End DoDot:2
End DoDot:1
+10 QUIT XUSCPRET
+11 ;
GETCPIEN() ;return CP IEN from User Class file
+1 QUIT +$ORDER(^VA(201,"B","CONNECTOR PROXY",""))
+2 ;
HDR ;
+1 WRITE "CONNECTOR PROXY REPORT: ",XUSCPRNT("DT EXT"),?70,$$RJ^XLFSTR("PAGE "_XUSCPRNT("PG"),9),!,XUSCPRNT("UL"),!
+2 QUIT
+3 ;
BLURB ;
+1 WRITE !,">>>Always contact the National Help Desk or Customer Support, to determine"
+2 WRITE !,"the best fix (and be alerted to known issues) for ANY problem listed below.",!
+3 WRITE !?10,"Coordinate all account changes with affected remote"
+4 WRITE !?15,"application to prevent service disruptions.",!
+5 QUIT
+6 ;
HDRCHK(Y) ;Y=excess lines, return 1 to exit
+1 ;return 0 to continue
+2 if +$GET(XUSCPQ)
QUIT 1
+3 if $Y<(IOSL-Y)
QUIT 0
+4 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+5 NEW DIR,I,J,K,X
+6 SET DIR(0)="E"
DO ^DIR
End DoDot:1
if 'Y
QUIT 1
+7 SET XUSCPRNT("PG")=XUSCPRNT("PG")+1
+8 WRITE @IOF
DO HDR
+9 QUIT 0
+10 ;
SCANLOG ;loop thru sign-on log for connector proxy activity, save results in ^TMP($J,"XUSCPLOG")
+1 NEW XUSCPSEC0,XUSCPSIGNON,XUSCPSECDUZ,XUSCPIP,XUSCPCUR,XUSCPLOOPC,XUSCPQ,XUSCPQC
+2 ;input: XUSCPLST(ACTIVE,DUZ) list of CPs
+3 ;search each ^XUSEC(0, date/time) 0-node
+4 SET (XUSCPSIGNON,XUSCPLOOPC)=0
SET XUSCPQC=100
+5 FOR
SET XUSCPSIGNON=$ORDER(^XUSEC(0,XUSCPSIGNON))
if '+XUSCPSIGNON!+$GET(XUSCPQ)
QUIT
Begin DoDot:1
+6 SET XUSCPLOOPC=XUSCPLOOPC+1
IF '+(XUSCPLOOPC#XUSCPQC)
IF $$S^%ZTLOAD()
SET (XUSCPQ,ZTSTOP)=1
QUIT
+7 ; get XUSEC 0 node, DUZ
SET XUSCPSEC0=^XUSEC(0,XUSCPSIGNON,0)
SET XUSCPSECDUZ=$PIECE(XUSCPSEC0,U)
+8 ; check if DUZ in CP list
IF +XUSCPSECDUZ
IF ($DATA(XUSCPLST(0,XUSCPSECDUZ))!$DATA(XUSCPLST(1,XUSCPSECDUZ)))
Begin DoDot:2
+9 ; get IP from XUSEC
SET XUSCPIP=$PIECE(XUSCPSEC0,U,11)
if XUSCPIP']""
SET XUSCPIP="unknown"
+10 ; check if job currently logged on
SET XUSCPCUR=$DATA(^XUSEC(0,"CUR",XUSCPSECDUZ,XUSCPDT))
+11 ;increment logon count per IP per day
+12 SET ^TMP($JOB,"XUSCPLOG",XUSCPSECDUZ,XUSCPIP,$PIECE(XUSCPSIGNON,"."))=+$GET(^TMP($JOB,"XUSCPLOG",XUSCPSECDUZ,XUSCPIP,$PIECE(XUSCPSIGNON,".")))+1
+13 ;increment currently signed on count
IF $DATA(^XUSEC(0,"CUR",XUSCPSECDUZ,XUSCPSIGNON))
Begin DoDot:3
+14 SET ^TMP($JOB,"XUSCPLOG",XUSCPSECDUZ,XUSCPIP,"CUR")=+$GET(^TMP($JOB,"XUSCPLOG",XUSCPSECDUZ,XUSCPIP,"CUR"))+1
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
ADDFLDS(XUSCPTAG,XUSCPARR) ;return list of fields in .XUSCPARR(fieldname)
+1 ; XUSCPTAG: tag to read field names from
+2 ; .XUSCPARR: array to populate (pass as .param)
+3 NEW I,XUSCPFLD
+4 FOR I=1:1
SET XUSCPFLD=$PIECE($TEXT(@XUSCPTAG+I),";;",2)
if '$LENGTH(XUSCPFLD)
QUIT
Begin DoDot:1
+5 SET XUSCPARR(XUSCPFLD)=""
End DoDot:1
+6 QUIT
+7 ;
OKFLDS ;top-level fields OK/expected to be populated
+1 ;;ACCESS CODE
+2 ;;CREATOR
+3 ;;DISUSER
+4 ;;Entry Last Edit Date
+5 ;;LAST SIGN-ON DATE/TIME
+6 ;;MULTIPLE SIGN-ON
+7 ;;NAME
+8 ;;NAME COMPONENTS
+9 ;;PROVIDER KEY
+10 ;;SERVICE/SECTION
+11 ;;SIGNATURE BLOCK PRINTED NAME
+12 ;;TIMESTAMP
+13 ;;VERIFY CODE
+14 ;;VERIFY CODE never expires
+15 ;;XUS Active User
+16 ;
INACFLDS ;fields OK to populate for an INACTIVE user
+1 ;;TERMINATION DATE
+2 ;
WARNFLDS ;field checked in WARNING section
+1 ;;DATE ACCESS CODE LAST CHANGED
+2 ;;DATE VERIFY CODE LAST CHANGED
+3 ;;DATE ENTERED
+4 ;;FILE MANAGER ACCESS CODE
+5 ;;SSN
+6 ;;XUS Logon Attempt Count
