PRCN109 ;WOIFO/SU-Extract Equipment Turn-In user counts ; 04/09/2001 03:30 PM
V ;;1.0;PRCN;**9**;Sep 13, 1996
;Per VHA Directive 10-93-142, this routine should not be modified.
;
POST ;
;
NEW I,J,K,STA,PSTA,LC,FDT,XMSUB,XMTEXT,XMY
NEW DIFROM
S U="^",DT=$$DT^XLFDT
K ^TMP("PRCN109")
S PSTA=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)
EQP ;
; Equipment Committee
S I=0,STA=PSTA F S I=$O(^PRCN(413.2,"B",I)) Q:'I D SETP(1)
;
CNCROFF ;
; Concurrence Officials
S I=0 F S I=$O(^PRCN(413.3,"B",I)) Q:'I D SETP(2)
;
KEYCHK ;
; Find user with security key
S I=0 F S I=$O(^VA(200,I)) Q:'I D
. ; Staff pick up turn-in requests
. I $D(^XUSEC("PRCNWHSE",I)) D SETP(5)
. ; Examiner of new/turn-in requests
. I $D(^XUSEC("PRCNEN",I)) D SETP(6)
;
CMROFC ;
; CMR Officials
S J=0 F S J=$O(^ENG(6914,"AD",J)) Q:'J D
. ; get station number
. S STA=+$P($G(^ENG(6914.1,J,0)),"^",7)
. I STA'?3N S STA=PSTA
. Q:STA=""
. ; Responsible Official
. S I=$P($G(^ENG(6914.1,J,0)),"^",2) I I D SETP(3) I $D(^XUSEC("PRCNCMR",I)) D SETP(4)
. ; Alternate Responsible Official
. S I=+$G(^ENG(6914.1,J,20)) I I D SETP(3) I $D(^XUSEC("PRCNCMR",I)) D SETP(4)
;
D RPT
EXIT ;
K ^TMP("PRCN109")
Q
;
RPT ;
; Generate report from ^TMP("PRCN109")
; 1. count from ^TMP
S STA=0 F S STA=$O(^TMP("PRCN109",$J,STA)) Q:'STA D
. K FDT S (FDT,I)=0
. F S I=$O(^TMP("PRCN109",$J,STA,I)) Q:'I S J=$G(^(I)) D
.. F K=1:1:6 I $P(J,"^",K) S FDT(K)=$G(FDT(K))+1
.. S FDT=FDT+1
. F K=1:1:6 D
.. S $P(^TMP("PRCN109",$J,STA),"^",K)=$G(FDT(K))
. S $P(^TMP("PRCN109",$J,STA),"^",7)=FDT
; 2. message for user before report
K FDT S FDT(1)="Counts are only broken out by station for CMR Official and CMR"
S FDT(2)="Official with PRCNCMR key as the files and security keys used"
S FDT(3)="in the analysis of the other roles do not distinguish users"
S FDT(4)="by station. For the latter, the users are reported in totals"
S FDT(5)="for the main station of the VistA installation."
; 3. format report using local array
F J=6,7 S FDT(J)=""
S LC=8,FDT(LC)="$REPORT"
S STA=0 F S STA=$O(^TMP("PRCN109",$J,STA)) Q:'STA S I=$G(^(STA)) D
. I LC>1 F J=1:1:3 S LC=LC+1,FDT(LC)=""
. S LC=LC+1,FDT(LC)=" EQUIPMENT TURN-IN USERS BY ROLE"
. S LC=LC+1,FDT(LC)=" STATION #: "_STA
. S LC=LC+1,FDT(LC)=" Role"_$J("Count",53)
. F K=1:1:6 D
.. S J=$P($T(FORMAT+K),";;",2)
.. S LC=LC+1,FDT(LC)=" "_J_$J(+$P(I,"^",K),57-$L(J))
. S LC=LC+1,J="Total Unique Equipment Turn-In Users"
. S FDT(LC)=" "_J_$J(+$P(I,"^",7),61-$L(J))
;
; $DATA
; Equipment Turn-In data
S LC=LC+1,FDT(LC)="$DATA(Equipment Turn-In)"
S STA=0 F S STA=$O(^TMP("PRCN109",$J,STA)) Q:'STA S J=^(STA) D
. S K="" F I=1:1:6 S K=K_+$P(J,"^",I)_","
. S LC=LC+1,FDT(LC)="Station"_STA_","_K_+$P(J,"^",7)
S LC=LC+1,FDT(LC)="$END"
;
MAIL ;
; Send report to mail group member and patch installer
X ^%ZOSF("UCI") S J=^%ZOSF("PROD")
S:J'["," Y=$P(Y,",")
; send report to mail group for PRODUCTION UCI only
I Y=J F I=1:1 S J=$T(MAILGRP+I),J=$P(J,";;",2) Q:J="" S XMY(J)=""
; mail to user who install patch 9
I $G(DUZ),$D(^VA(200,DUZ)) S XMY(DUZ)=""
S STA=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",.01)
I STA="" S STA="UNKNOWN"
S XMSUB="Extract Equipment Turn-In Users by Role ("_STA_")"
S XMTEXT="FDT("
D ^XMD
Q
MAILGRP ;
;;G.coreFLS VistA Stats@DOMAIN.EXT
;;
Q
FORMAT ;
;;Equipment Committee
;;Concurrence Officials
;;CMR Official
;;CMR Official with PRCNCMR key
;;Staff who assign pickups for turn-in Requests
;;Engineering staff who examine new/turn-in Requests
;;
SETP(PC) ;
; set value into ^TMP, STA -- station number, I -- DUZ
; If termination date is smaller than today's date
I $P($G(^VA(200,I,0)),"^",11),DT>$P(^(0),"^",11) Q
I '$P($G(^TMP("PRCN109",$J,STA,I)),"^",PC) S $P(^(I),"^",PC)=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCN109 3966 printed Mar 13, 2024@23:02:58 Page 2
PRCN109 ;WOIFO/SU-Extract Equipment Turn-In user counts ; 04/09/2001 03:30 PM
V ;;1.0;PRCN;**9**;Sep 13, 1996
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
POST ;
+1 ;
+2 NEW I,J,K,STA,PSTA,LC,FDT,XMSUB,XMTEXT,XMY
+3 NEW DIFROM
+4 SET U="^"
SET DT=$$DT^XLFDT
+5 KILL ^TMP("PRCN109")
+6 SET PSTA=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)
EQP ;
+1 ; Equipment Committee
+2 SET I=0
SET STA=PSTA
FOR
SET I=$ORDER(^PRCN(413.2,"B",I))
if 'I
QUIT
DO SETP(1)
+3 ;
CNCROFF ;
+1 ; Concurrence Officials
+2 SET I=0
FOR
SET I=$ORDER(^PRCN(413.3,"B",I))
if 'I
QUIT
DO SETP(2)
+3 ;
KEYCHK ;
+1 ; Find user with security key
+2 SET I=0
FOR
SET I=$ORDER(^VA(200,I))
if 'I
QUIT
Begin DoDot:1
+3 ; Staff pick up turn-in requests
+4 IF $DATA(^XUSEC("PRCNWHSE",I))
DO SETP(5)
+5 ; Examiner of new/turn-in requests
+6 IF $DATA(^XUSEC("PRCNEN",I))
DO SETP(6)
End DoDot:1
+7 ;
CMROFC ;
+1 ; CMR Officials
+2 SET J=0
FOR
SET J=$ORDER(^ENG(6914,"AD",J))
if 'J
QUIT
Begin DoDot:1
+3 ; get station number
+4 SET STA=+$PIECE($GET(^ENG(6914.1,J,0)),"^",7)
+5 IF STA'?3N
SET STA=PSTA
+6 if STA=""
QUIT
+7 ; Responsible Official
+8 SET I=$PIECE($GET(^ENG(6914.1,J,0)),"^",2)
IF I
DO SETP(3)
IF $DATA(^XUSEC("PRCNCMR",I))
DO SETP(4)
+9 ; Alternate Responsible Official
+10 SET I=+$GET(^ENG(6914.1,J,20))
IF I
DO SETP(3)
IF $DATA(^XUSEC("PRCNCMR",I))
DO SETP(4)
End DoDot:1
+11 ;
+12 DO RPT
EXIT ;
+1 KILL ^TMP("PRCN109")
+2 QUIT
+3 ;
RPT ;
+1 ; Generate report from ^TMP("PRCN109")
+2 ; 1. count from ^TMP
+3 SET STA=0
FOR
SET STA=$ORDER(^TMP("PRCN109",$JOB,STA))
if 'STA
QUIT
Begin DoDot:1
+4 KILL FDT
SET (FDT,I)=0
+5 FOR
SET I=$ORDER(^TMP("PRCN109",$JOB,STA,I))
if 'I
QUIT
SET J=$GET(^(I))
Begin DoDot:2
+6 FOR K=1:1:6
IF $PIECE(J,"^",K)
SET FDT(K)=$GET(FDT(K))+1
+7 SET FDT=FDT+1
End DoDot:2
+8 FOR K=1:1:6
Begin DoDot:2
+9 SET $PIECE(^TMP("PRCN109",$JOB,STA),"^",K)=$GET(FDT(K))
End DoDot:2
+10 SET $PIECE(^TMP("PRCN109",$JOB,STA),"^",7)=FDT
End DoDot:1
+11 ; 2. message for user before report
+12 KILL FDT
SET FDT(1)="Counts are only broken out by station for CMR Official and CMR"
+13 SET FDT(2)="Official with PRCNCMR key as the files and security keys used"
+14 SET FDT(3)="in the analysis of the other roles do not distinguish users"
+15 SET FDT(4)="by station. For the latter, the users are reported in totals"
+16 SET FDT(5)="for the main station of the VistA installation."
+17 ; 3. format report using local array
+18 FOR J=6,7
SET FDT(J)=""
+19 SET LC=8
SET FDT(LC)="$REPORT"
+20 SET STA=0
FOR
SET STA=$ORDER(^TMP("PRCN109",$JOB,STA))
if 'STA
QUIT
SET I=$GET(^(STA))
Begin DoDot:1
+21 IF LC>1
FOR J=1:1:3
SET LC=LC+1
SET FDT(LC)=""
+22 SET LC=LC+1
SET FDT(LC)=" EQUIPMENT TURN-IN USERS BY ROLE"
+23 SET LC=LC+1
SET FDT(LC)=" STATION #: "_STA
+24 SET LC=LC+1
SET FDT(LC)=" Role"_$JUSTIFY("Count",53)
+25 FOR K=1:1:6
Begin DoDot:2
+26 SET J=$PIECE($TEXT(FORMAT+K),";;",2)
+27 SET LC=LC+1
SET FDT(LC)=" "_J_$JUSTIFY(+$PIECE(I,"^",K),57-$LENGTH(J))
End DoDot:2
+28 SET LC=LC+1
SET J="Total Unique Equipment Turn-In Users"
+29 SET FDT(LC)=" "_J_$JUSTIFY(+$PIECE(I,"^",7),61-$LENGTH(J))
End DoDot:1
+30 ;
+31 ; $DATA
+32 ; Equipment Turn-In data
+33 SET LC=LC+1
SET FDT(LC)="$DATA(Equipment Turn-In)"
+34 SET STA=0
FOR
SET STA=$ORDER(^TMP("PRCN109",$JOB,STA))
if 'STA
QUIT
SET J=^(STA)
Begin DoDot:1
+35 SET K=""
FOR I=1:1:6
SET K=K_+$PIECE(J,"^",I)_","
+36 SET LC=LC+1
SET FDT(LC)="Station"_STA_","_K_+$PIECE(J,"^",7)
End DoDot:1
+37 SET LC=LC+1
SET FDT(LC)="$END"
+38 ;
MAIL ;
+1 ; Send report to mail group member and patch installer
+2 XECUTE ^%ZOSF("UCI")
SET J=^%ZOSF("PROD")
+3 if J'[","
SET Y=$PIECE(Y,",")
+4 ; send report to mail group for PRODUCTION UCI only
+5 IF Y=J
FOR I=1:1
SET J=$TEXT(MAILGRP+I)
SET J=$PIECE(J,";;",2)
if J=""
QUIT
SET XMY(J)=""
+6 ; mail to user who install patch 9
+7 IF $GET(DUZ)
IF $DATA(^VA(200,DUZ))
SET XMY(DUZ)=""
+8 SET STA=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",.01)
+9 IF STA=""
SET STA="UNKNOWN"
+10 SET XMSUB="Extract Equipment Turn-In Users by Role ("_STA_")"
+11 SET XMTEXT="FDT("
+12 DO ^XMD
+13 QUIT
MAILGRP ;
+1 ;;G.coreFLS VistA Stats@DOMAIN.EXT
+2 ;;
+3 QUIT
FORMAT ;
+1 ;;Equipment Committee
+2 ;;Concurrence Officials
+3 ;;CMR Official
+4 ;;CMR Official with PRCNCMR key
+5 ;;Staff who assign pickups for turn-in Requests
+6 ;;Engineering staff who examine new/turn-in Requests
+7 ;;
SETP(PC) ;
+1 ; set value into ^TMP, STA -- station number, I -- DUZ
+2 ; If termination date is smaller than today's date
+3 IF $PIECE($GET(^VA(200,I,0)),"^",11)
IF DT>$PIECE(^(0),"^",11)
QUIT
+4 IF '$PIECE($GET(^TMP("PRCN109",$JOB,STA,I)),"^",PC)
SET $PIECE(^(I),"^",PC)=1
+5 QUIT