Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCN109

PRCN109.m

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