PRC168P.m

PRC168P ;VMP/RB - PRCFA SUPERVISOR key setting/audit ;03/01/12

 ;;5.1;IFCAP;**168**;Oct 20, 2000;Build 3

 ;;Per VHA Directive 2004-038, this routine should not be modified.

 ;;

 Q

START ;

 ;   Post install to set key PRCFA SUPERVISOR terminate setting

 ;   to 'NO" and audit to look for terminated employees having

 ;   PRCFA SUPERVISOR key.

 ;

 Q:$D(^XTMP("PRC168P"))

SETUP D NOW^%DTC S RMSTART=%,(T1,T2,T3)=0

 S ^XTMP("PRC168P","START COMPILE")=RMSTART

 S ^XTMP("PRC168P","END COMPILE")="RUNNING"

 S ^XTMP("PRC168P",0)=$$FMADD^XLFDT(RMSTART,120)_"^"_RMSTART

SET S CPOKEY=$O(^DIC(19.1,"B","PRCFA SUPERVISOR",0)) D:CPOKEY  I 'CPOKEY W !!,"** NO PRCFA SUPERVISOR KEY DEFINED AS IFCAP SECURITY KEY **" G EXIT

 . S R0=^DIC(19.1,CPOKEY,0)

 . S ^XTMP("PRC168P","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 PRCFA SUPERVISOR

 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("PRC168P",STS,IEN,0)=$P(R0,U)_U_$P(R0,U,11)

 Q

EXIT ;

 D NOW^%DTC S RMEND=%

 S ^XTMP("PRC168P","END COMPILE")=RMEND_U_T1_U_T2_U_T3

 W !!,"Number of TERMINATED employees with key PRCFA SUPERVISOR still assigned: ",T1

 W !!,"Number of ACTIVE employees with key PRCFA SUPERVISOR 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 ---PRC168P   1764     printed  Apr 09, 2024@21:15:45                                                                                                                                                                                                     Page 2

PRC168P   ;VMP/RB - PRCFA SUPERVISOR key setting/audit ;03/01/12

 +1       ;;5.1;IFCAP;**168**;Oct 20, 2000;Build 3

 +2       ;;Per VHA Directive 2004-038, this routine should not be modified.

 +3       ;;

 +4        QUIT 

START     ;

 +1       ;   Post install to set key PRCFA SUPERVISOR terminate setting

 +2       ;   to 'NO" and audit to look for terminated employees having

 +3       ;   PRCFA SUPERVISOR key.

 +4       ;

 +5        if $DATA(^XTMP("PRC168P"))

               QUIT 

SETUP      DO NOW^%DTC

           SET RMSTART=%

           SET (T1,T2,T3)=0

 +1        SET ^XTMP("PRC168P","START COMPILE")=RMSTART

 +2        SET ^XTMP("PRC168P","END COMPILE")="RUNNING"

 +3        SET ^XTMP("PRC168P",0)=$$FMADD^XLFDT(RMSTART,120)_"^"_RMSTART

SET        SET CPOKEY=$ORDER(^DIC(19.1,"B","PRCFA SUPERVISOR",0))

           if CPOKEY

               Begin DoDot:1

 +1                SET R0=^DIC(19.1,CPOKEY,0)

 +2                SET ^XTMP("PRC168P","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 PRCFA SUPERVISOR KEY DEFINED AS IFCAP SECURITY KEY **"

               GOTO EXIT

AUDIT     ;FIND EMPLOYEES IN ^VA(200) W/ KEY PRCFA SUPERVISOR

 +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("PRC168P",STS,IEN,0)=$PIECE(R0,U)_U_$PIECE(R0,U,11)

 +1        QUIT 

EXIT      ;

 +1        DO NOW^%DTC

           SET RMEND=%

 +2        SET ^XTMP("PRC168P","END COMPILE")=RMEND_U_T1_U_T2_U_T3

 +3        WRITE !!,"Number of TERMINATED employees with key PRCFA SUPERVISOR still assigned: ",T1

 +4        WRITE !!,"Number of ACTIVE employees with key PRCFA SUPERVISOR 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