PRC159P.m

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 ---PRC159P   1724     printed  Apr 09, 2024@21:11:41                                                                                                                                                                                                     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