- 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 Mar 13, 2025@21:04:12 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
