PRC159P ;VMP/RB - PRCSCPO key setting/audit ;08/01/11
;;5.1;IFCAP;**159**;Aug 1, 2011;Build 9
;;Per VHA Directive 2004-038, this routine should not be modified.
;;
Q
START ;
; Pre install to set key PRCSCPO terminate setting to 'NO" and
; audit to look for terminated employees having PRCSCPO key.
;
Q:$D(^XTMP("PRC159P"))
K ^XTMP("PRC159P")
SETUP K ^XTMP("PRC159P") D NOW^%DTC S RMSTART=%,(T1,T2,T3)=0
S ^XTMP("PRC159P","START COMPILE")=RMSTART
S ^XTMP("PRC159P","END COMPILE")="RUNNING"
S ^XTMP("PRC159P",0)=$$FMADD^XLFDT(RMSTART,120)_"^"_RMSTART
SET S CPOKEY=$O(^DIC(19.1,"B","PRCSCPO",0)) D:CPOKEY I 'CPOKEY W !!,"** NO PRCSCPO KEY DEFINED AS IFCAP SECURITY KEY **" G EXIT
. S R0=^DIC(19.1,CPOKEY,0)
. S ^XTMP("PRC159P","KEY",0)=$P(R0,U,4)_U_"n"
. S DA=CPOKEY,DIE="^DIC(19.1,",DR=".04///n" D ^DIE
AUDIT ;FIND EMPLOYEES IN ^VA(200) W/ KEY PRCSCPO
S IEN=0,U="^"
1 S IEN=$O(^VA(200,IEN)) G EXIT:IEN=""!(IEN]"@")
S R0=$G(^VA(200,IEN,0)) I R0="" S STS="X",T3=T3+1 D 3 G 1
2 S VAKEY=$O(^VA(200,IEN,51,"B",CPOKEY,0)) G 1:VAKEY=""!(VAKEY]"@") D
. S KR0=$G(^VA(200,IEN,51,VAKEY,0)) Q:$P(KR0,U)'=VAKEY
. I $P(R0,U,11) S STS="T",T1=T1+1 D D 3 Q
.. S DA=VAKEY,DA(1)=IEN,DIK="^VA(200,"_DA(1)_",51," D ^DIK
. S STS="A",T2=T2+1 D 3
G 1
3 S ^XTMP("PRC159P",STS,IEN,0)=$P(R0,U)_U_$P(R0,U,11)
Q
EXIT ;
D NOW^%DTC S RMEND=%
S ^XTMP("PRC159P","END COMPILE")=RMEND_U_T1_U_T2_U_T3
W !!,"Number of TERMINATED employees with key PRCSCPO still assigned: ",T1
W !!,"Number of ACTIVE employees with key PRCSCPO still assigned: ",T2
W !!,"Number of employees with *NO* node 0 information: ",T3
K RMEND,RMSTART,%,DR,DA,DIE,DIK,IEN,IENKEY,VAKEY,CPOKEY,T1,T2,T3,STS,R0,KR0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRC159P 1724 printed Dec 13, 2024@01:59:23 Page 2
PRC159P ;VMP/RB - PRCSCPO key setting/audit ;08/01/11
+1 ;;5.1;IFCAP;**159**;Aug 1, 2011;Build 9
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;;
+4 QUIT
START ;
+1 ; Pre install to set key PRCSCPO terminate setting to 'NO" and
+2 ; audit to look for terminated employees having PRCSCPO key.
+3 ;
+4 if $DATA(^XTMP("PRC159P"))
QUIT
+5 KILL ^XTMP("PRC159P")
SETUP KILL ^XTMP("PRC159P")
DO NOW^%DTC
SET RMSTART=%
SET (T1,T2,T3)=0
+1 SET ^XTMP("PRC159P","START COMPILE")=RMSTART
+2 SET ^XTMP("PRC159P","END COMPILE")="RUNNING"
+3 SET ^XTMP("PRC159P",0)=$$FMADD^XLFDT(RMSTART,120)_"^"_RMSTART
SET SET CPOKEY=$ORDER(^DIC(19.1,"B","PRCSCPO",0))
if CPOKEY
Begin DoDot:1
+1 SET R0=^DIC(19.1,CPOKEY,0)
+2 SET ^XTMP("PRC159P","KEY",0)=$PIECE(R0,U,4)_U_"n"
+3 SET DA=CPOKEY
SET DIE="^DIC(19.1,"
SET DR=".04///n"
DO ^DIE
End DoDot:1
IF 'CPOKEY
WRITE !!,"** NO PRCSCPO KEY DEFINED AS IFCAP SECURITY KEY **"
GOTO EXIT
AUDIT ;FIND EMPLOYEES IN ^VA(200) W/ KEY PRCSCPO
+1 SET IEN=0
SET U="^"
1 SET IEN=$ORDER(^VA(200,IEN))
if IEN=""!(IEN]"@")
GOTO EXIT
+1 SET R0=$GET(^VA(200,IEN,0))
IF R0=""
SET STS="X"
SET T3=T3+1
DO 3
GOTO 1
2 SET VAKEY=$ORDER(^VA(200,IEN,51,"B",CPOKEY,0))
if VAKEY=""!(VAKEY]"@")
GOTO 1
Begin DoDot:1
+1 SET KR0=$GET(^VA(200,IEN,51,VAKEY,0))
if $PIECE(KR0,U)'=VAKEY
QUIT
+2 IF $PIECE(R0,U,11)
SET STS="T"
SET T1=T1+1
Begin DoDot:2
+3 SET DA=VAKEY
SET DA(1)=IEN
SET DIK="^VA(200,"_DA(1)_",51,"
DO ^DIK
End DoDot:2
DO 3
QUIT
+4 SET STS="A"
SET T2=T2+1
DO 3
End DoDot:1
+5 GOTO 1
3 SET ^XTMP("PRC159P",STS,IEN,0)=$PIECE(R0,U)_U_$PIECE(R0,U,11)
+1 QUIT
EXIT ;
+1 DO NOW^%DTC
SET RMEND=%
+2 SET ^XTMP("PRC159P","END COMPILE")=RMEND_U_T1_U_T2_U_T3
+3 WRITE !!,"Number of TERMINATED employees with key PRCSCPO still assigned: ",T1
+4 WRITE !!,"Number of ACTIVE employees with key PRCSCPO still assigned: ",T2
+5 WRITE !!,"Number of employees with *NO* node 0 information: ",T3
+6 KILL RMEND,RMSTART,%,DR,DA,DIE,DIK,IEN,IENKEY,VAKEY,CPOKEY,T1,T2,T3,STS,R0,KR0
+7 QUIT
