ENEQPMS5 ;(WASH ISC)/DH-Generate PM Work Orders ;4.10.98
;;7.0;ENGINEERING;**35,42,51**;Aug 17, 1993
; Creates or finds work orders for a specified PM worklist
; and then makes calls to print that document
; Global ^TMP($J,... contains sort order and equip entry numbers
;
PR ; Begin
I '$D(^TMP($J,"ENWL")) W !!,"PM Worklist was requested, but there's nothing to print." Q
N I,J,K,X,X1,EN,ENX,TECH,DA,DIC,DIE
N H,W,SE,MULT,NODE,HDR,LINE,TIME,VACANT
S ENLABOR=$P($G(^DIC(6910,1,0)),U,4)
I IOM>93 S HDR="HDR96^ENEQPMS6",LINE="LN96^ENEQPMS7"
E S HDR="HDR80^ENEQPMS6",LINE="LN80^ENEQPMS7"
D NOW^%DTC S Y=%,ENDATE=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_($E(Y,1,3)+1700)
I HDR="HDR96^ENEQPMS6" X ^DD("DD") S TIME=$P(Y,":",1,2)
S (TECH,ENPG,ENY)=0
S ENEXPAND=0 S I=$O(^ENG(6910.2,"B","EXPANDED PM WORK ORDERS",0))
I I>0,$P(^ENG(6910.2,I,0),U,2)="Y" S ENEXPAND=1
U IO S X=""
S NODE="^TMP($J,""ENWL"",0)",NODE=$Q(@NODE),SUB=$QL(NODE)
S ENSHKEY=0 K ENXP
F Q:$G(X)="^" S ENSHKEY=$O(^TMP($J,"ENWL",ENSHKEY)) D:ENSHKEY="" HOLD Q:'ENSHKEY!($G(X)="^") S:ENTECH'=0 ENEMP=$O(^TMP($J,"ENWL",ENSHKEY,"")) S DA=$QS(NODE,SUB),ENHZ=@NODE D PR1
I $D(ENXP("LOCK")) W !!,"Abnormal termination. This worklist may be incomplete." H 5
D TRLR
G OUT ;Design EXIT
;
PR1 S ENSHOP=$P(^DIC(6922,ENSHKEY,0),U,1),ENSHABR=$P(^(0),U,2),ENCODE="PM-"_ENSHABR_ENPMDT_ENPM,X=""
S ENWO=$O(^ENG(6920,"B",ENCODE_"-9999"),-1) S:ENWO'[ENCODE ENWO=ENCODE_"-001"
;
I ENTECH=0 D Q ;Worklist without RESP TECH
. D TRLR,@HDR S ENPG(0)=ENPG F Q:$G(X)="^" D PR2 Q:$G(X)="^" S NODE=$Q(@NODE) Q:$QS(NODE,3)'=ENSHKEY S DA=$QS(NODE,SUB),ENHZ=@NODE Q:DA'>0
;
D EMP ;With RESP TECH (may or may not be sorted by tech)
D TRLR,@HDR S ENPG(0)=ENPG F Q:$G(X)="^" D PR2 Q:$G(X)="^" S NODE=$Q(@NODE) Q:$QS(NODE,3)'=ENSHKEY D Q:DA'>0
. I $QS(NODE,4)'=ENEMP S ENEMP=$QS(NODE,4) D EMP,TRLR,@HDR S ENPG(0)=ENPG
. S DA=$QS(NODE,SUB),ENHZ=@NODE
Q ;Return to design EXIT
;
PR2 S ENHZ(1)=$P(ENHZ,U,2),SE=$P(ENHZ,U,3),MULT=$P(ENHZ,U,4),ENHZ=$P(ENHZ,U)
S ENWOX="",X1=0 F S X1=$O(^ENG(6920,"G",DA,X1)) Q:X1'>0 I $P($G(^ENG(6920,X1,0)),U)[ENCODE S ENWOX=$P(^(0),U) Q
S X1=0 F S X1=$O(^ENG(6914,DA,6,X1)) Q:X1'>0 I $P(^(X1,0),U,2)[ENCODE S ENWOX="*" Q
Q:ENWOX="*" ;PM already done
G:ENWOX]"" PR3
;
PR22 ; Must create a new work order
L +^ENG(6920,"B"):20 I '$T S ENXP("LOCK")=1 Q
PR221 I $D(^ENG(6920,"B",ENWO))!($D(^ENG(6920,"H",ENWO))) S J=$P(ENWO,"-",3)+1,J=$S($L(J)=1:"00"_J,$L(J)=2:"0"_J,1:J),ENWO=$P(ENWO,"-",1,2)_"-"_J G PR221
K DD,DO S DIC="^ENG(6920,",DIC(0)="LX",X=ENWO D FILE^DICN S ENNXL=+Y
L:ENNXL>0 +^ENG(6920,ENNXL):1
L -^ENG(6920,"B")
I ENNXL'>0 S ENXP("LOCK")=1 Q
S $P(^ENG(6920,ENNXL,0),U,2)=DT,$P(^ENG(6920,ENNXL,3),U,8)=DA,^ENG(6920,"G",DA,ENNXL)="",^ENG(6920,ENNXL,2)=ENSHKEY
S X1=$O(^ENG(6920.1,"B","PREVENTIVE MAINTENANCE",0))
I X1>0,$D(^ENG(6920.1,X1,0)) S ^ENG(6920,ENNXL,8,0)="^6920.035PA^1^1",^ENG(6920,ENNXL,8,1,0)=X1
I $D(^ENG(6914,DA,3)) S EN=^(3),ENPMN=$P(EN,U,6),ENLOC=$P(EN,U,5) S:ENPMN]"" $P(^ENG(6920,ENNXL,3),U)=ENPMN,^ENG(6920,"E",ENPMN,ENNXL)="" I ENLOC]"",ENLOC?.N S $P(^ENG(6920,ENNXL,0),U,4)=ENLOC,^ENG(6920,"C",ENLOC,ENNXL)=""
S $P(^ENG(6920,ENNXL,5),U,7)=ENHZ(1)_" PMI"
S EN=$G(^ENG(6914,DA,4,SE,2,MULT,0)) I EN="" S ENDA=DA,DA=ENNXL,DIK="^ENG(6920," D:$E(^ENG(6920,DA,0),1,3)="PM-" ^DIK K DIK S DA=ENDA Q
I $P(EN,U,4)]"" S ENLVL=$P(EN,U,4),$P(^ENG(6920,ENNXL,5),U,7)=$P(^ENG(6920,ENNXL,5),U,7)_" Level "_ENLVL
I $P(EN,U,5)]"" S ENPRC=$P(EN,U,5),ENPROC(2)=$S($D(^ENG(6914.2,ENPRC,0)):$S($P(^(0),U,2)]"":$P(^(0),U,2),1:$P(^(0),U)),1:ENPRC),$P(^ENG(6920,ENNXL,5),U,7)=$P(^ENG(6920,ENNXL,5),U,7)_" "_ENPROC(2)
I ENTECH=0 S TECH=$P(^ENG(6914,DA,4,SE,0),U,2) S:TECH="" TECH=0 I TECH>0 S:'$D(^ENG("EMP",TECH,0)) TECH=0
S:TECH=0 ENEMP=0
I TECH>0 D ;Set ASSIGNED and RESPONSIBLE TECH
. S $P(^ENG(6920,ENNXL,2),U,2)=TECH
. S ^ENG(6920,ENNXL,7,0)="^6920.02PA^1^1",^ENG(6920,ENNXL,7,1,0)=TECH
. S ENEMP=$P(^ENG("EMP",TECH,0),U)
S ENDA=DA,DA=ENNXL D TEST^ENWOCOMP
I ENEXPAND D ST^ENWOINV S:$D(^ENG(6920,DA,5)) $P(^(1),U,2)=$P(^(5),U,7)
S DA=ENDA
I $P(EN,U,2)]""!($P(EN,U,3)]"") D WOCST
L -^ENG(6920,ENNXL)
S ENWO(1)=ENWO,K=$P(ENWO,"-",3),K=K+1,K=$S($L(K)=1:"00"_K,$L(K)=2:"0"_K,1:K),ENWO=$P(ENWO,"-",1,2)_"-"_K
PR3 ;
S:ENWOX="" ENWOX=ENWO(1) I ENY+11>IOSL D TRLR,@HDR Q:X="^"
D @LINE
Q
;
EMP S VACANT=0 I ENEMP=0 S TECH=0 Q
S TECH=$O(^ENG("EMP","B",ENEMP,0)) I TECH'>0 S TECH=0 Q
I '$D(^ENG("EMP",TECH,0)) S (TECH,ENEMP)=0 Q
S:$P(^ENG("EMP",TECH,0),U,7)="V" VACANT=1
Q
;
WOCST S W="" I $G(TECH)>0,$D(^ENG("EMP",TECH,0)) S W=$P(^(0),U,3)
S:W="" W=ENLABOR
S H=$P(EN,U,2) I $D(^ENG(6920,ENNXL,7,0)) S $P(^ENG(6920,ENNXL,7,1,0),U,2,3)=H_"^"_ENSHKEY
I H>0 S $P(^ENG(6920,ENNXL,5),U,3)=H I W>0 S $P(^(5),U,6)=$J(H*W,0,2) ;Labor cost (est.)
S $P(^ENG(6920,ENNXL,5),U,4)=$P(EN,U,3) ;Material cost (est.)
Q
;
HOLD I $G(ENPG(0))>0,ENPG=ENPG(0),ENY'>7 W !!,"There are no incomplete PM work orders to print.",!
I $E(IOST,1,2)="C-" R !,"Press <RETURN> to continue, '^' to escape...",X:DTIME S:'$T X=U
Q
;
TRLR ; Interpret PM STATUS and CONDITION CODE
I ENPG,($E(IOST,1,2)'="C-"!($D(IO("S")))) D
. F Q:$Y>(IOSL-6) W !
. W "STATUS: P=>Pass C=>Corrective action D0=>Deferred D1=>Could not locate"
. W !," D2=>In use D3=>Out of service CONDITION: LN=>Like new G=>Good P=>Poor"
. W !,"Y2K: FC=>Fully compl NC=>Non-compl CC=>Conditionally compl NA=>Not appl"
. W !,"Techs may circle STATUS and/or CONDITION. Y2K CATEGORY is information only."
Q
;
OUT K ENSHABR,ENCODE,ENWO,ENWOX,ENTECH,ENSRT,ENPG,ENY,ENPMN,ENID,ENMAN,ENMANF,ENMOD,ENSN,ENLID,ENLOC,ENPRC,ENPROC,ENDTYP,ENDVTYP,ENUSE,ENDA
K ENHZ,ENLVL,ENEMP,ENNXL,ENNXT,ENSTAT,ENFNO,ENSRVC,ENWING,ENHRS,ENMAT,ENEXPAND,ENCOND,ENX,ENMFGR,ENLABOR,ENDATE
K ^TMP($J)
I $E(IOST,1,2)="P-",'$D(ZTQUEUED) D ^%ZISC
Q
;ENEQPMS5
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENEQPMS5 5939 printed Apr 09, 2024@20:58:36 Page 2
ENEQPMS5 ;(WASH ISC)/DH-Generate PM Work Orders ;4.10.98
+1 ;;7.0;ENGINEERING;**35,42,51**;Aug 17, 1993
+2 ; Creates or finds work orders for a specified PM worklist
+3 ; and then makes calls to print that document
+4 ; Global ^TMP($J,... contains sort order and equip entry numbers
+5 ;
PR ; Begin
+1 IF '$DATA(^TMP($JOB,"ENWL"))
WRITE !!,"PM Worklist was requested, but there's nothing to print."
QUIT
+2 NEW I,J,K,X,X1,EN,ENX,TECH,DA,DIC,DIE
+3 NEW H,W,SE,MULT,NODE,HDR,LINE,TIME,VACANT
+4 SET ENLABOR=$PIECE($GET(^DIC(6910,1,0)),U,4)
+5 IF IOM>93
SET HDR="HDR96^ENEQPMS6"
SET LINE="LN96^ENEQPMS7"
+6 IF '$TEST
SET HDR="HDR80^ENEQPMS6"
SET LINE="LN80^ENEQPMS7"
+7 DO NOW^%DTC
SET Y=%
SET ENDATE=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_($EXTRACT(Y,1,3)+1700)
+8 IF HDR="HDR96^ENEQPMS6"
XECUTE ^DD("DD")
SET TIME=$PIECE(Y,":",1,2)
+9 SET (TECH,ENPG,ENY)=0
+10 SET ENEXPAND=0
SET I=$ORDER(^ENG(6910.2,"B","EXPANDED PM WORK ORDERS",0))
+11 IF I>0
IF $PIECE(^ENG(6910.2,I,0),U,2)="Y"
SET ENEXPAND=1
+12 USE IO
SET X=""
+13 SET NODE="^TMP($J,""ENWL"",0)"
SET NODE=$QUERY(@NODE)
SET SUB=$QLENGTH(NODE)
+14 SET ENSHKEY=0
KILL ENXP
+15 FOR
if $GET(X)="^"
QUIT
SET ENSHKEY=$ORDER(^TMP($JOB,"ENWL",ENSHKEY))
if ENSHKEY=""
DO HOLD
if 'ENSHKEY!($GET(X)="^")
QUIT
if ENTECH'=0
SET ENEMP=$ORDER(^TMP($JOB,"ENWL",ENSHKEY,""))
SET DA=$QSUBSCRIPT(NODE,SUB)
SET ENHZ=@NODE
DO PR1
+16 IF $DATA(ENXP("LOCK"))
WRITE !!,"Abnormal termination. This worklist may be incomplete."
HANG 5
+17 DO TRLR
+18 ;Design EXIT
GOTO OUT
+19 ;
PR1 SET ENSHOP=$PIECE(^DIC(6922,ENSHKEY,0),U,1)
SET ENSHABR=$PIECE(^(0),U,2)
SET ENCODE="PM-"_ENSHABR_ENPMDT_ENPM
SET X=""
+1 SET ENWO=$ORDER(^ENG(6920,"B",ENCODE_"-9999"),-1)
if ENWO'[ENCODE
SET ENWO=ENCODE_"-001"
+2 ;
+3 ;Worklist without RESP TECH
IF ENTECH=0
Begin DoDot:1
+4 DO TRLR
DO @HDR
SET ENPG(0)=ENPG
FOR
if $GET(X)="^"
QUIT
DO PR2
if $GET(X)="^"
QUIT
SET NODE=$QUERY(@NODE)
if $QSUBSCRIPT(NODE,3)'=ENSHKEY
QUIT
SET DA=$QSUBSCRIPT(NODE,SUB)
SET ENHZ=@NODE
if DA'>0
QUIT
End DoDot:1
QUIT
+5 ;
+6 ;With RESP TECH (may or may not be sorted by tech)
DO EMP
+7 DO TRLR
DO @HDR
SET ENPG(0)=ENPG
FOR
if $GET(X)="^"
QUIT
DO PR2
if $GET(X)="^"
QUIT
SET NODE=$QUERY(@NODE)
if $QSUBSCRIPT(NODE,3)'=ENSHKEY
QUIT
Begin DoDot:1
+8 IF $QSUBSCRIPT(NODE,4)'=ENEMP
SET ENEMP=$QSUBSCRIPT(NODE,4)
DO EMP
DO TRLR
DO @HDR
SET ENPG(0)=ENPG
+9 SET DA=$QSUBSCRIPT(NODE,SUB)
SET ENHZ=@NODE
End DoDot:1
if DA'>0
QUIT
+10 ;Return to design EXIT
QUIT
+11 ;
PR2 SET ENHZ(1)=$PIECE(ENHZ,U,2)
SET SE=$PIECE(ENHZ,U,3)
SET MULT=$PIECE(ENHZ,U,4)
SET ENHZ=$PIECE(ENHZ,U)
+1 SET ENWOX=""
SET X1=0
FOR
SET X1=$ORDER(^ENG(6920,"G",DA,X1))
if X1'>0
QUIT
IF $PIECE($GET(^ENG(6920,X1,0)),U)[ENCODE
SET ENWOX=$PIECE(^(0),U)
QUIT
+2 SET X1=0
FOR
SET X1=$ORDER(^ENG(6914,DA,6,X1))
if X1'>0
QUIT
IF $PIECE(^(X1,0),U,2)[ENCODE
SET ENWOX="*"
QUIT
+3 ;PM already done
if ENWOX="*"
QUIT
+4 if ENWOX]""
GOTO PR3
+5 ;
PR22 ; Must create a new work order
+1 LOCK +^ENG(6920,"B"):20
IF '$TEST
SET ENXP("LOCK")=1
QUIT
PR221 IF $DATA(^ENG(6920,"B",ENWO))!($DATA(^ENG(6920,"H",ENWO)))
SET J=$PIECE(ENWO,"-",3)+1
SET J=$SELECT($LENGTH(J)=1:"00"_J,$LENGTH(J)=2:"0"_J,1:J)
SET ENWO=$PIECE(ENWO,"-",1,2)_"-"_J
GOTO PR221
+1 KILL DD,DO
SET DIC="^ENG(6920,"
SET DIC(0)="LX"
SET X=ENWO
DO FILE^DICN
SET ENNXL=+Y
+2 if ENNXL>0
LOCK +^ENG(6920,ENNXL):1
+3 LOCK -^ENG(6920,"B")
+4 IF ENNXL'>0
SET ENXP("LOCK")=1
QUIT
+5 SET $PIECE(^ENG(6920,ENNXL,0),U,2)=DT
SET $PIECE(^ENG(6920,ENNXL,3),U,8)=DA
SET ^ENG(6920,"G",DA,ENNXL)=""
SET ^ENG(6920,ENNXL,2)=ENSHKEY
+6 SET X1=$ORDER(^ENG(6920.1,"B","PREVENTIVE MAINTENANCE",0))
+7 IF X1>0
IF $DATA(^ENG(6920.1,X1,0))
SET ^ENG(6920,ENNXL,8,0)="^6920.035PA^1^1"
SET ^ENG(6920,ENNXL,8,1,0)=X1
+8 IF $DATA(^ENG(6914,DA,3))
SET EN=^(3)
SET ENPMN=$PIECE(EN,U,6)
SET ENLOC=$PIECE(EN,U,5)
if ENPMN]""
SET $PIECE(^ENG(6920,ENNXL,3),U)=ENPMN
SET ^ENG(6920,"E",ENPMN,ENNXL)=""
IF ENLOC]""
IF ENLOC?.N
SET $PIECE(^ENG(6920,ENNXL,0),U,4)=ENLOC
SET ^ENG(6920,"C",ENLOC,ENNXL)=""
+9 SET $PIECE(^ENG(6920,ENNXL,5),U,7)=ENHZ(1)_" PMI"
+10 SET EN=$GET(^ENG(6914,DA,4,SE,2,MULT,0))
IF EN=""
SET ENDA=DA
SET DA=ENNXL
SET DIK="^ENG(6920,"
if $EXTRACT(^ENG(6920,DA,0),1,3)="PM-"
DO ^DIK
KILL DIK
SET DA=ENDA
QUIT
+11 IF $PIECE(EN,U,4)]""
SET ENLVL=$PIECE(EN,U,4)
SET $PIECE(^ENG(6920,ENNXL,5),U,7)=$PIECE(^ENG(6920,ENNXL,5),U,7)_" Level "_ENLVL
+12 IF $PIECE(EN,U,5)]""
SET ENPRC=$PIECE(EN,U,5)
SET ENPROC(2)=$SELECT($DATA(^ENG(6914.2,ENPRC,0)):$SELECT($PIECE(^(0),U,2)]"":$PIECE(^(0),U,2),1:$PIECE(^(0),U)),1:ENPRC)
SET $PIECE(^ENG(6920,ENNXL,5),U,7)=$PIECE(^ENG(6920,ENNXL,5),U,7)_" "_ENPROC(2)
+13 IF ENTECH=0
SET TECH=$PIECE(^ENG(6914,DA,4,SE,0),U,2)
if TECH=""
SET TECH=0
IF TECH>0
if '$DATA(^ENG("EMP",TECH,0))
SET TECH=0
+14 if TECH=0
SET ENEMP=0
+15 ;Set ASSIGNED and RESPONSIBLE TECH
IF TECH>0
Begin DoDot:1
+16 SET $PIECE(^ENG(6920,ENNXL,2),U,2)=TECH
+17 SET ^ENG(6920,ENNXL,7,0)="^6920.02PA^1^1"
SET ^ENG(6920,ENNXL,7,1,0)=TECH
+18 SET ENEMP=$PIECE(^ENG("EMP",TECH,0),U)
End DoDot:1
+19 SET ENDA=DA
SET DA=ENNXL
DO TEST^ENWOCOMP
+20 IF ENEXPAND
DO ST^ENWOINV
if $DATA(^ENG(6920,DA,5))
SET $PIECE(^(1),U,2)=$PIECE(^(5),U,7)
+21 SET DA=ENDA
+22 IF $PIECE(EN,U,2)]""!($PIECE(EN,U,3)]"")
DO WOCST
+23 LOCK -^ENG(6920,ENNXL)
+24 SET ENWO(1)=ENWO
SET K=$PIECE(ENWO,"-",3)
SET K=K+1
SET K=$SELECT($LENGTH(K)=1:"00"_K,$LENGTH(K)=2:"0"_K,1:K)
SET ENWO=$PIECE(ENWO,"-",1,2)_"-"_K
PR3 ;
+1 if ENWOX=""
SET ENWOX=ENWO(1)
IF ENY+11>IOSL
DO TRLR
DO @HDR
if X="^"
QUIT
+2 DO @LINE
+3 QUIT
+4 ;
EMP SET VACANT=0
IF ENEMP=0
SET TECH=0
QUIT
+1 SET TECH=$ORDER(^ENG("EMP","B",ENEMP,0))
IF TECH'>0
SET TECH=0
QUIT
+2 IF '$DATA(^ENG("EMP",TECH,0))
SET (TECH,ENEMP)=0
QUIT
+3 if $PIECE(^ENG("EMP",TECH,0),U,7)="V"
SET VACANT=1
+4 QUIT
+5 ;
WOCST SET W=""
IF $GET(TECH)>0
IF $DATA(^ENG("EMP",TECH,0))
SET W=$PIECE(^(0),U,3)
+1 if W=""
SET W=ENLABOR
+2 SET H=$PIECE(EN,U,2)
IF $DATA(^ENG(6920,ENNXL,7,0))
SET $PIECE(^ENG(6920,ENNXL,7,1,0),U,2,3)=H_"^"_ENSHKEY
+3 ;Labor cost (est.)
IF H>0
SET $PIECE(^ENG(6920,ENNXL,5),U,3)=H
IF W>0
SET $PIECE(^(5),U,6)=$JUSTIFY(H*W,0,2)
+4 ;Material cost (est.)
SET $PIECE(^ENG(6920,ENNXL,5),U,4)=$PIECE(EN,U,3)
+5 QUIT
+6 ;
HOLD IF $GET(ENPG(0))>0
IF ENPG=ENPG(0)
IF ENY'>7
WRITE !!,"There are no incomplete PM work orders to print.",!
+1 IF $EXTRACT(IOST,1,2)="C-"
READ !,"Press <RETURN> to continue, '^' to escape...",X:DTIME
if '$TEST
SET X=U
+2 QUIT
+3 ;
TRLR ; Interpret PM STATUS and CONDITION CODE
+1 IF ENPG
IF ($EXTRACT(IOST,1,2)'="C-"!($DATA(IO("S"))))
Begin DoDot:1
+2 FOR
if $Y>(IOSL-6)
QUIT
WRITE !
+3 WRITE "STATUS: P=>Pass C=>Corrective action D0=>Deferred D1=>Could not locate"
+4 WRITE !," D2=>In use D3=>Out of service CONDITION: LN=>Like new G=>Good P=>Poor"
+5 WRITE !,"Y2K: FC=>Fully compl NC=>Non-compl CC=>Conditionally compl NA=>Not appl"
+6 WRITE !,"Techs may circle STATUS and/or CONDITION. Y2K CATEGORY is information only."
End DoDot:1
+7 QUIT
+8 ;
OUT KILL ENSHABR,ENCODE,ENWO,ENWOX,ENTECH,ENSRT,ENPG,ENY,ENPMN,ENID,ENMAN,ENMANF,ENMOD,ENSN,ENLID,ENLOC,ENPRC,ENPROC,ENDTYP,ENDVTYP,ENUSE,ENDA
+1 KILL ENHZ,ENLVL,ENEMP,ENNXL,ENNXT,ENSTAT,ENFNO,ENSRVC,ENWING,ENHRS,ENMAT,ENEXPAND,ENCOND,ENX,ENMFGR,ENLABOR,ENDATE
+2 KILL ^TMP($JOB)
+3 IF $EXTRACT(IOST,1,2)="P-"
IF '$DATA(ZTQUEUED)
DO ^%ZISC
+4 QUIT
+5 ;ENEQPMS5
