- 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 Feb 18, 2025@23:20:31 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