PRC5129 ;(WOIFO)/SU-Extract IFCAP user counts ; 04/09/2001 03:30 PM
V ;;5.1;IFCAP;**29**;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
;
POST ;
;
NEW I,J,K,IE,FCP,DONE,STA,ESTA,IVP,LOA,LC,FDT,MGR,XMSUB,XMTEXT,XMY
NEW DIFROM
S U="^",DT=$$DT^XLFDT
K ^TMP("PRC5129")
FCP ;
; Control Point
S I=0 F S I=$O(^PRC(420,"C",I)) Q:'I D
. S STA=0 F S STA=$O(^PRC(420,"C",I,STA)) Q:'STA D
.. S FCP=0,K=4,DONE=0
.. F S FCP=$O(^PRC(420,"C",I,STA,FCP)) Q:'FCP!DONE D
... ; skip Inactive Fund
... I $P(^PRC(420,STA,1,FCP,0),"^",19) Q
... ; get control point Level Of Access
... S LOA=$P($G(^PRC(420,STA,1,FCP,1,I,0)),"^",2)
... I LOA>3!'LOA Q
... I K>LOA S K=LOA ; K only keep the highest level of access
... I LOA=1 S DONE=1 ; Stop here if find official level
.. I K'=4 D SETP(K)
;
INV ;
; Inventory
;
; sort user by station # through "AD",DUZ x-ref
S I=0 F S I=$O(^PRCP(445,"AD",I)) Q:'I D
. S IVP=0 K MGR ;get inv pointer
. F S IVP=$O(^PRCP(445,"AD",I,IVP)) Q:'IVP D
.. S J=$P(^PRCP(445,IVP,0),"^",3) ; get inv type
.. S STA=+^PRCP(445,IVP,0) ; get station number
.. S ^TMP("PRC5129",$J,"INV",STA,I,J)=""
;
S STA=0 F S STA=$O(^TMP("PRC5129",$J,"INV",STA)) Q:'STA D
. S I=0 F S I=$O(^TMP("PRC5129",$J,"INV",STA,I)) Q:'I D
.. S J="" F S J=$O(^TMP("PRC5129",$J,"INV",STA,I,J)) Q:J="" D
... I J="W" D ; Warehouse
.... D SETP(7) ; user
.... I $D(^XUSEC("PRCPW MGRKEY",I)) D SETP(4) ; manager
... I J="P" D ; Primary
.... D SETP(8) ; user
.... I $D(^XUSEC("PRCP MGRKEY",I)) D SETP(5) ; manager
... I J="S" D ; Secondary
.... D SETP(9) ; user
.... I $D(^XUSEC("PRCP2 MGRKEY",I)) D SETP(6) ; manager
;
PRCH ;
; purchasing
;
; get IFCAP primary station number (assume only one primary)
S STA=+$O(^PRC(411,"AC","Y",0))
;
; get default station for Engineering (piece 17, ^XTV(8989.3,1,"XUS"))
S ESTA=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)
;
S I=0 F S I=$O(^VA(200,I)) Q:'I D
. ; Purchasing
. S J=+$G(^VA(200,I,400))
. I J,J<5 D
.. I J=1 D SETP(13) ; Warehouse Employee
.. I J=2 D SETP(10) ; PPM Accountable Officer
.. I J=3 D SETP(11) ; Purchasing Agent
.. I J=4 D SETP(12) ; Supply Manager
. ; Engineering
. ; Logic copied from ENZACC2 by Scott Baumann
. S K=0 I $$ACCESS^XQCHK(I,"ENINVNEW")>0 D SETE(1) S K=1
. I 'K,$$ACCESS^XQCHK(I,"ENINVINV")>0 D SETE(2) S K=1
. I $$ACCESS^XQCHK(I,"ENSPROOM")>0 D SETE(4) S K=1
. I $$ACCESS^XQCHK(I,"ENWONEW")>0 D SETE(3) S $E(K,2)=1
. I '$E(K,2),$$ACCESS^XQCHK(I,"ENWOCLOSE")>0 D SETE(3) S $E(K,2)=1
. I +K D SETE(5)
. ; if none of the first 5 case is true or
. ; case SETE(3) is not true but other case is true
. I ($E(K,2)'=1&+K)!'K I $$ACCESS^XQCHK(I,"ENWONEW-WARD")>0 D SETE(6)
. ; count Accounting Staff 1 time only per station
. I $D(^XUSEC("PRCFA SUPERVISOR",I)) D SETP(15) Q
. I $D(^XUSEC("PRCFA TRANSMIT",I)) D SETP(15) Q
. I $D(^XUSEC("PRCFA VENDOR EDIT",I)) D SETP(15) Q
. I $D(^XUSEC("PRCFA PURGE CODE SHEETS",I)) D SETP(15) Q
;
;
BUDGET ;
S STA=0 F S STA=$O(^PRC(420,STA)) Q:'STA D
. S I=0 F S I=$O(^PRC(420,STA,2,I)) Q:'I D SETP(14)
;
ACNT ;
; Accounting
S STA=0 F S STA=$O(^PRC(411,"AE",1,STA)) Q:'STA!(STA>999) D
. S I=0 F S I=$O(^PRC(411,STA,6,I)) Q:'I D SETP(15)
;
PCARD ;
; Purchase Card
S J=0 F S J=$O(^PRC(440.5,J)) Q:'J S K=$G(^(J,0)) D
. S STA=$P($G(^PRC(440.5,J,2)),"^",3) Q:'STA
. I $P(^PRC(440.5,J,2),"^",2)="Y" Q ; if Inactive flag set to 'Y'
. S I=$P(K,"^",8) I I D SETP(16) ; Purchase card holder
. S I=$P(K,"^",9) I I D SETP(18) ; P card approving officer
. S I=$P(K,"^",10) I I D SETP(19) ; Alt. P card approving officer
. ; Get surrogate user which is not the card holder
. S I=0 F S I=$O(^PRC(440.5,J,1,I)) Q:'I D:$P(K,"^",8)'=I SETP(17)
;
D RPT
EXIT ;
K ^TMP("PRC5129")
Q
;
RPT ;
; Generate report from ^TMP("PRC5129")
; 1. count from ^TMP
F IE="I","E" D
. S STA=0 F S STA=$O(^TMP("PRC5129",$J,IE,STA)) Q:'STA D
.. K FDT S (FDT,I)=0
.. F S I=$O(^TMP("PRC5129",$J,IE,STA,I)) Q:'I S J=$G(^(I)) D
... F K=1:1:$S(IE="I":19,1:6) I $P(J,"^",K) S FDT(K)=$G(FDT(K))+1
... S:IE="I" FDT=FDT+1
.. F K=1:1:$S(IE="I":19,1:6) D
... S $P(^TMP("PRC5129",$J,IE,STA),"^",K)=$G(FDT(K))
.. I IE="I" S $P(^TMP("PRC5129",$J,"I",STA),"^",20)=FDT
; 2. format report using local array
K FDT S LC=1,FDT(LC)="$REPORT"
F IE="I","E" D
. S STA=0 F S STA=$O(^TMP("PRC5129",$J,IE,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)=" "_$S(IE="I":"IFCAP",1:"ENGINEERING")_" USERS BY ROLE"
.. S LC=LC+1,FDT(LC)=" STATION #: "_STA
.. S LC=LC+1,FDT(LC)=" Role"_$J("Count",38)
.. F K=1:1:$S(IE="I":19,1:4) D
... S:IE="I" J=$P($T(FORMAT+K),";;",2)
... S:IE="E" J=$P($T(ENGFMT+K),";;",2)
... S LC=LC+1,FDT(LC)=" "_J_$J(+$P(I,"^",K),42-$L(J))
.. S LC=LC+1,J="Total Unique "_$S(IE="I":"IFCAP",1:"ENGINEERING")_" Users"
.. S FDT(LC)=" "_J_$J(+$P(I,"^",$S(IE="I":20,1:5)),46-$L(J))
.. I IE="E" D
... S LC=LC+1,J="Electronic Work Order Requesters"
... S FDT(LC)=" "_J_$J(+$P(I,"^",6),46-$L(J))
;
; $DATA
; IFCAP data
S LC=LC+1,FDT(LC)="$DATA(IFCAP)"
S STA=0 F S STA=$O(^TMP("PRC5129",$J,"I",STA)) Q:'STA S J=^(STA) D
. S K="" F I=1:1:19 S K=K_+$P(J,"^",I)_","
. S LC=LC+1,FDT(LC)="Station"_STA_","_K_+$P(J,"^",20)
; Engineering data
S LC=LC+1,FDT(LC)="$DATA(ENGINEERING)"
S STA=$O(^TMP("PRC5129",$J,"E",0)) I STA S J=^(STA) D
. S K="" F I=1:1:5 S K=K_+$P(J,"^",I)_","
. S LC=LC+1,FDT(LC)="Station"_STA_","_K_+$P(J,"^",6)
S LC=LC+1,FDT(LC)="$END"
;
MAIL ;
; get mail group member
F I=1:1 S J=$T(MAILGRP+I),J=$P(J,";;",2) Q:J="" S XMY(J)=""
; mail to user who install patch 29
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 IFCAP Users by Role ("_STA_")"
S XMTEXT="FDT("
D ^XMD
Q
MAILGRP ;
;;G.coreFLS VistA Stats@DOMAIN.EXT
;;
Q
FORMAT ;
;;FCP Official
;;FCP Clerk
;;FCP Requestor
;;Warehouse Inv Manager
;;Primary Inv Manager
;;Secondary Inv Manager
;;Warehouse Inv User
;;Primary Inv User
;;Secondary Inv User
;;PPM Accountable Officer
;;Purchasing Agent
;;Supply Manager
;;Warehouse Employee
;;Budget Releasing Official
;;Accounting Staff
;;Purchase Card Holder
;;Purchase Card Surrogate
;;Purchase Card Approving Official
;;Alt PC Approving Official
;;
ENGFMT ;
;;Asset Update
;;Asset View Only
;;Engr. Work Order
;;Update Location
;;
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("PRC5129",$J,"I",STA,I)),"^",PC) S $P(^(I),"^",PC)=1
Q
;
SETE(PC) ;
; set value into ^TMP, ESTA -- engineer 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("PRC5129",$J,"E",ESTA,I)),"^",PC) S $P(^(I),"^",PC)=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRC5129 7562 printed Apr 09, 2024@21:00:36 Page 2
PRC5129 ;(WOIFO)/SU-Extract IFCAP user counts ; 04/09/2001 03:30 PM
V ;;5.1;IFCAP;**29**;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
POST ;
+1 ;
+2 NEW I,J,K,IE,FCP,DONE,STA,ESTA,IVP,LOA,LC,FDT,MGR,XMSUB,XMTEXT,XMY
+3 NEW DIFROM
+4 SET U="^"
SET DT=$$DT^XLFDT
+5 KILL ^TMP("PRC5129")
FCP ;
+1 ; Control Point
+2 SET I=0
FOR
SET I=$ORDER(^PRC(420,"C",I))
if 'I
QUIT
Begin DoDot:1
+3 SET STA=0
FOR
SET STA=$ORDER(^PRC(420,"C",I,STA))
if 'STA
QUIT
Begin DoDot:2
+4 SET FCP=0
SET K=4
SET DONE=0
+5 FOR
SET FCP=$ORDER(^PRC(420,"C",I,STA,FCP))
if 'FCP!DONE
QUIT
Begin DoDot:3
+6 ; skip Inactive Fund
+7 IF $PIECE(^PRC(420,STA,1,FCP,0),"^",19)
QUIT
+8 ; get control point Level Of Access
+9 SET LOA=$PIECE($GET(^PRC(420,STA,1,FCP,1,I,0)),"^",2)
+10 IF LOA>3!'LOA
QUIT
+11 ; K only keep the highest level of access
IF K>LOA
SET K=LOA
+12 ; Stop here if find official level
IF LOA=1
SET DONE=1
End DoDot:3
+13 IF K'=4
DO SETP(K)
End DoDot:2
End DoDot:1
+14 ;
INV ;
+1 ; Inventory
+2 ;
+3 ; sort user by station # through "AD",DUZ x-ref
+4 SET I=0
FOR
SET I=$ORDER(^PRCP(445,"AD",I))
if 'I
QUIT
Begin DoDot:1
+5 ;get inv pointer
SET IVP=0
KILL MGR
+6 FOR
SET IVP=$ORDER(^PRCP(445,"AD",I,IVP))
if 'IVP
QUIT
Begin DoDot:2
+7 ; get inv type
SET J=$PIECE(^PRCP(445,IVP,0),"^",3)
+8 ; get station number
SET STA=+^PRCP(445,IVP,0)
+9 SET ^TMP("PRC5129",$JOB,"INV",STA,I,J)=""
End DoDot:2
End DoDot:1
+10 ;
+11 SET STA=0
FOR
SET STA=$ORDER(^TMP("PRC5129",$JOB,"INV",STA))
if 'STA
QUIT
Begin DoDot:1
+12 SET I=0
FOR
SET I=$ORDER(^TMP("PRC5129",$JOB,"INV",STA,I))
if 'I
QUIT
Begin DoDot:2
+13 SET J=""
FOR
SET J=$ORDER(^TMP("PRC5129",$JOB,"INV",STA,I,J))
if J=""
QUIT
Begin DoDot:3
+14 ; Warehouse
IF J="W"
Begin DoDot:4
+15 ; user
DO SETP(7)
+16 ; manager
IF $DATA(^XUSEC("PRCPW MGRKEY",I))
DO SETP(4)
End DoDot:4
+17 ; Primary
IF J="P"
Begin DoDot:4
+18 ; user
DO SETP(8)
+19 ; manager
IF $DATA(^XUSEC("PRCP MGRKEY",I))
DO SETP(5)
End DoDot:4
+20 ; Secondary
IF J="S"
Begin DoDot:4
+21 ; user
DO SETP(9)
+22 ; manager
IF $DATA(^XUSEC("PRCP2 MGRKEY",I))
DO SETP(6)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 ;
PRCH ;
+1 ; purchasing
+2 ;
+3 ; get IFCAP primary station number (assume only one primary)
+4 SET STA=+$ORDER(^PRC(411,"AC","Y",0))
+5 ;
+6 ; get default station for Engineering (piece 17, ^XTV(8989.3,1,"XUS"))
+7 SET ESTA=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)
+8 ;
+9 SET I=0
FOR
SET I=$ORDER(^VA(200,I))
if 'I
QUIT
Begin DoDot:1
+10 ; Purchasing
+11 SET J=+$GET(^VA(200,I,400))
+12 IF J
IF J<5
Begin DoDot:2
+13 ; Warehouse Employee
IF J=1
DO SETP(13)
+14 ; PPM Accountable Officer
IF J=2
DO SETP(10)
+15 ; Purchasing Agent
IF J=3
DO SETP(11)
+16 ; Supply Manager
IF J=4
DO SETP(12)
End DoDot:2
+17 ; Engineering
+18 ; Logic copied from ENZACC2 by Scott Baumann
+19 SET K=0
IF $$ACCESS^XQCHK(I,"ENINVNEW")>0
DO SETE(1)
SET K=1
+20 IF 'K
IF $$ACCESS^XQCHK(I,"ENINVINV")>0
DO SETE(2)
SET K=1
+21 IF $$ACCESS^XQCHK(I,"ENSPROOM")>0
DO SETE(4)
SET K=1
+22 IF $$ACCESS^XQCHK(I,"ENWONEW")>0
DO SETE(3)
SET $EXTRACT(K,2)=1
+23 IF '$EXTRACT(K,2)
IF $$ACCESS^XQCHK(I,"ENWOCLOSE")>0
DO SETE(3)
SET $EXTRACT(K,2)=1
+24 IF +K
DO SETE(5)
+25 ; if none of the first 5 case is true or
+26 ; case SETE(3) is not true but other case is true
+27 IF ($EXTRACT(K,2)'=1&+K)!'K
IF $$ACCESS^XQCHK(I,"ENWONEW-WARD")>0
DO SETE(6)
+28 ; count Accounting Staff 1 time only per station
+29 IF $DATA(^XUSEC("PRCFA SUPERVISOR",I))
DO SETP(15)
QUIT
+30 IF $DATA(^XUSEC("PRCFA TRANSMIT",I))
DO SETP(15)
QUIT
+31 IF $DATA(^XUSEC("PRCFA VENDOR EDIT",I))
DO SETP(15)
QUIT
+32 IF $DATA(^XUSEC("PRCFA PURGE CODE SHEETS",I))
DO SETP(15)
QUIT
End DoDot:1
+33 ;
+34 ;
BUDGET ;
+1 SET STA=0
FOR
SET STA=$ORDER(^PRC(420,STA))
if 'STA
QUIT
Begin DoDot:1
+2 SET I=0
FOR
SET I=$ORDER(^PRC(420,STA,2,I))
if 'I
QUIT
DO SETP(14)
End DoDot:1
+3 ;
ACNT ;
+1 ; Accounting
+2 SET STA=0
FOR
SET STA=$ORDER(^PRC(411,"AE",1,STA))
if 'STA!(STA>999)
QUIT
Begin DoDot:1
+3 SET I=0
FOR
SET I=$ORDER(^PRC(411,STA,6,I))
if 'I
QUIT
DO SETP(15)
End DoDot:1
+4 ;
PCARD ;
+1 ; Purchase Card
+2 SET J=0
FOR
SET J=$ORDER(^PRC(440.5,J))
if 'J
QUIT
SET K=$GET(^(J,0))
Begin DoDot:1
+3 SET STA=$PIECE($GET(^PRC(440.5,J,2)),"^",3)
if 'STA
QUIT
+4 ; if Inactive flag set to 'Y'
IF $PIECE(^PRC(440.5,J,2),"^",2)="Y"
QUIT
+5 ; Purchase card holder
SET I=$PIECE(K,"^",8)
IF I
DO SETP(16)
+6 ; P card approving officer
SET I=$PIECE(K,"^",9)
IF I
DO SETP(18)
+7 ; Alt. P card approving officer
SET I=$PIECE(K,"^",10)
IF I
DO SETP(19)
+8 ; Get surrogate user which is not the card holder
+9 SET I=0
FOR
SET I=$ORDER(^PRC(440.5,J,1,I))
if 'I
QUIT
if $PIECE(K,"^",8)'=I
DO SETP(17)
End DoDot:1
+10 ;
+11 DO RPT
EXIT ;
+1 KILL ^TMP("PRC5129")
+2 QUIT
+3 ;
RPT ;
+1 ; Generate report from ^TMP("PRC5129")
+2 ; 1. count from ^TMP
+3 FOR IE="I","E"
Begin DoDot:1
+4 SET STA=0
FOR
SET STA=$ORDER(^TMP("PRC5129",$JOB,IE,STA))
if 'STA
QUIT
Begin DoDot:2
+5 KILL FDT
SET (FDT,I)=0
+6 FOR
SET I=$ORDER(^TMP("PRC5129",$JOB,IE,STA,I))
if 'I
QUIT
SET J=$GET(^(I))
Begin DoDot:3
+7 FOR K=1:1:$SELECT(IE="I":19,1:6)
IF $PIECE(J,"^",K)
SET FDT(K)=$GET(FDT(K))+1
+8 if IE="I"
SET FDT=FDT+1
End DoDot:3
+9 FOR K=1:1:$SELECT(IE="I":19,1:6)
Begin DoDot:3
+10 SET $PIECE(^TMP("PRC5129",$JOB,IE,STA),"^",K)=$GET(FDT(K))
End DoDot:3
+11 IF IE="I"
SET $PIECE(^TMP("PRC5129",$JOB,"I",STA),"^",20)=FDT
End DoDot:2
End DoDot:1
+12 ; 2. format report using local array
+13 KILL FDT
SET LC=1
SET FDT(LC)="$REPORT"
+14 FOR IE="I","E"
Begin DoDot:1
+15 SET STA=0
FOR
SET STA=$ORDER(^TMP("PRC5129",$JOB,IE,STA))
if 'STA
QUIT
SET I=$GET(^(STA))
Begin DoDot:2
+16 IF LC>1
FOR J=1:1:3
SET LC=LC+1
SET FDT(LC)=""
+17 SET LC=LC+1
SET FDT(LC)=" "_$SELECT(IE="I":"IFCAP",1:"ENGINEERING")_" USERS BY ROLE"
+18 SET LC=LC+1
SET FDT(LC)=" STATION #: "_STA
+19 SET LC=LC+1
SET FDT(LC)=" Role"_$JUSTIFY("Count",38)
+20 FOR K=1:1:$SELECT(IE="I":19,1:4)
Begin DoDot:3
+21 if IE="I"
SET J=$PIECE($TEXT(FORMAT+K),";;",2)
+22 if IE="E"
SET J=$PIECE($TEXT(ENGFMT+K),";;",2)
+23 SET LC=LC+1
SET FDT(LC)=" "_J_$JUSTIFY(+$PIECE(I,"^",K),42-$LENGTH(J))
End DoDot:3
+24 SET LC=LC+1
SET J="Total Unique "_$SELECT(IE="I":"IFCAP",1:"ENGINEERING")_" Users"
+25 SET FDT(LC)=" "_J_$JUSTIFY(+$PIECE(I,"^",$SELECT(IE="I":20,1:5)),46-$LENGTH(J))
+26 IF IE="E"
Begin DoDot:3
+27 SET LC=LC+1
SET J="Electronic Work Order Requesters"
+28 SET FDT(LC)=" "_J_$JUSTIFY(+$PIECE(I,"^",6),46-$LENGTH(J))
End DoDot:3
End DoDot:2
End DoDot:1
+29 ;
+30 ; $DATA
+31 ; IFCAP data
+32 SET LC=LC+1
SET FDT(LC)="$DATA(IFCAP)"
+33 SET STA=0
FOR
SET STA=$ORDER(^TMP("PRC5129",$JOB,"I",STA))
if 'STA
QUIT
SET J=^(STA)
Begin DoDot:1
+34 SET K=""
FOR I=1:1:19
SET K=K_+$PIECE(J,"^",I)_","
+35 SET LC=LC+1
SET FDT(LC)="Station"_STA_","_K_+$PIECE(J,"^",20)
End DoDot:1
+36 ; Engineering data
+37 SET LC=LC+1
SET FDT(LC)="$DATA(ENGINEERING)"
+38 SET STA=$ORDER(^TMP("PRC5129",$JOB,"E",0))
IF STA
SET J=^(STA)
Begin DoDot:1
+39 SET K=""
FOR I=1:1:5
SET K=K_+$PIECE(J,"^",I)_","
+40 SET LC=LC+1
SET FDT(LC)="Station"_STA_","_K_+$PIECE(J,"^",6)
End DoDot:1
+41 SET LC=LC+1
SET FDT(LC)="$END"
+42 ;
MAIL ;
+1 ; get mail group member
+2 FOR I=1:1
SET J=$TEXT(MAILGRP+I)
SET J=$PIECE(J,";;",2)
if J=""
QUIT
SET XMY(J)=""
+3 ; mail to user who install patch 29
+4 IF $GET(DUZ)
IF $DATA(^VA(200,DUZ))
SET XMY(DUZ)=""
+5 SET STA=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",.01)
+6 IF STA=""
SET STA="UNKNOWN"
+7 SET XMSUB="Extract IFCAP Users by Role ("_STA_")"
+8 SET XMTEXT="FDT("
+9 DO ^XMD
+10 QUIT
MAILGRP ;
+1 ;;G.coreFLS VistA Stats@DOMAIN.EXT
+2 ;;
+3 QUIT
FORMAT ;
+1 ;;FCP Official
+2 ;;FCP Clerk
+3 ;;FCP Requestor
+4 ;;Warehouse Inv Manager
+5 ;;Primary Inv Manager
+6 ;;Secondary Inv Manager
+7 ;;Warehouse Inv User
+8 ;;Primary Inv User
+9 ;;Secondary Inv User
+10 ;;PPM Accountable Officer
+11 ;;Purchasing Agent
+12 ;;Supply Manager
+13 ;;Warehouse Employee
+14 ;;Budget Releasing Official
+15 ;;Accounting Staff
+16 ;;Purchase Card Holder
+17 ;;Purchase Card Surrogate
+18 ;;Purchase Card Approving Official
+19 ;;Alt PC Approving Official
+20 ;;
ENGFMT ;
+1 ;;Asset Update
+2 ;;Asset View Only
+3 ;;Engr. Work Order
+4 ;;Update Location
+5 ;;
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("PRC5129",$JOB,"I",STA,I)),"^",PC)
SET $PIECE(^(I),"^",PC)=1
+5 QUIT
+6 ;
SETE(PC) ;
+1 ; set value into ^TMP, ESTA -- engineer 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("PRC5129",$JOB,"E",ESTA,I)),"^",PC)
SET $PIECE(^(I),"^",PC)=1
+5 QUIT
