ENEQMED ;WISC/SAB-Multiple Equipment Edit ;9/24/97
;;7.0;ENGINEERING**35,45**;;Aug 17, 1993
W !,"Multiple Equipment Edit",!
I $G(IO)="" D HOME^%ZIS
S ENEDNX=$D(^XUSEC("ENEDNX",DUZ))
K ^TMP($J)
PO ; get purchase order #
K ENPO,ENA,ENX
S DIR(0)="6914,11" D ^DIR K DIR G:Y']""!$D(DIRUT) EXIT S ENX=Y
I $D(^ENG(6914,"M",ENX)) S ENPO=ENX G POEND
; try an alternate format (add/remove station)
S ENA=$S(ENX["-":$P(ENX,"-",2),1:$P($G(^DIC(6910,1,0)),U,2)_"-"_ENX)
I ENA]"",$D(^ENG(6914,"M",ENA)) S ENPO=ENA G POEND
; show partial matches
S DIC="^ENG(6914,",ENDX="M",X=ENX D IX^ENLIB1 I X]"" S ENPO=X G POEND
I ENA]"" S X=ENA D IX^ENLIB1 I X]"" S ENPO=X G POEND
W $C(7),!,"No equipment with purchase order # '",ENX,"' found in"
W !,"the Equipment Inventory file."
G PO
POEND ; have purchase order #
; store and sort equip in tmp
K ^TMP($J,"ENPO")
S ENDA=0 F S ENDA=$O(^ENG(6914,"M",ENPO,ENDA)) Q:'ENDA D
. S DIC=6914,DR="6;1;4",DA=ENDA,DIQ="ENQ",DIQ(0)="I" D EN^DIQ1 K DIQ
. F Y=6,1,4 I ENQ(6914,DA,Y,"I")']"" S ENQ(6914,DA,Y,"I")="?"
. S ^TMP($J,"ENPO",ENQ(6914,DA,6,"I"),ENQ(6914,DA,1,"I"),ENQ(6914,DA,4,"I"),DA)=""
. K ENQ
; build array ENL() of category-manufacturer-model combinations
K ENL S (ENL,ENC("PO"))=0
S ENCATI=""
F S ENCATI=$O(^TMP($J,"ENPO",ENCATI)) Q:ENCATI']"" D
. I ENCATI S DIC=6911,DR=".01",DA=ENCATI,DIQ="ENQ" D EN^DIQ1 K DIQ
. S ENCAT=$S(ENCATI:$E(ENQ(6911,ENCATI,.01),1,24),1:"unspecified") K ENQ
. S ENMANI=""
. F S ENMANI=$O(^TMP($J,"ENPO",ENCATI,ENMANI)) Q:ENMANI']"" D
. . I ENMANI S DIC=6912,DR=".01",DA=ENMANI,DIQ="ENQ" D EN^DIQ1 K DIQ
. . S ENMAN=$S(ENMANI:$E(ENQ(6912,ENMANI,.01),1,24),1:"unspecified") K ENQ
. . S ENMOD=""
. . F S ENMOD=$O(^TMP($J,"ENPO",ENCATI,ENMANI,ENMOD)) Q:ENMOD']"" D
. . . S ENDA=0,ENC("LINE")=0
. . . F S ENDA=$O(^TMP($J,"ENPO",ENCATI,ENMANI,ENMOD,ENDA)) Q:'ENDA D
. . . . S ENC("LINE")=ENC("LINE")+1
. . . S ENL=ENL+1
. . . S ENL(ENL)=ENCATI_U_ENCAT
. . . S ENL(ENL)=ENL(ENL)_U_ENMANI_U_ENMAN_U_ENMOD_U
. . . S ENL(ENL)=ENL(ENL)_$S(ENMOD="?":"unspecified",1:$E(ENMOD,1,14))
. . . S ENL(ENL)=ENL(ENL)_U_ENC("LINE")
. . . S ENC("PO")=ENC("PO")+ENC("LINE")
S ENL("MAX")=ENL
; display array
W @IOF
W ENC("PO")," Equipment Items found with Purchase Order # = ",ENPO
W !,"Line",?6,"Equipment Category",?32,"Manufacturer"
W ?58,"Model",?74,"Count",!
F ENL=1:1:ENL("MAX") D
. W !,ENL,?6,$P(ENL(ENL),U,2),?32,$P(ENL(ENL),U,4)
. W ?58,$P(ENL(ENL),U,6),?74,$P(ENL(ENL),U,7)
; get lines to edit
S DIR(0)="L^1:"_ENL("MAX")
S DIR("A")="Select line(s) to edit"
D ^DIR K DIR G:$D(DIRUT) EXIT S ENL("SEL")=Y
S ENC("SEL")=0
F ENI=1:1 S ENL=$P(ENL("SEL"),",",ENI) Q:'ENL S ENC("SEL")=ENC("SEL")+$P(ENL(ENL),U,7)
W !,ENC("SEL")," Equipment Items will be edited",!
; save/lock selected equipment
K ^TMP($J,"ENSEL")
S ENLOCK("BATCH")=$S(ENC("SEL")>50:0,1:1) ;lock batch (all) or as-edited
S ENNX=0,ENFA=0,ENLOCK=1
F ENI=1:1 S ENL=$P(ENL("SEL"),",",ENI) Q:'ENL D
. S ENCATI=$P(ENL(ENL),U,1)
. S ENMANI=$P(ENL(ENL),U,3)
. S ENMOD=$P(ENL(ENL),U,5)
. S ENDA=0
. F S ENDA=$O(^TMP($J,"ENPO",ENCATI,ENMANI,ENMOD,ENDA)) Q:'ENDA!'ENLOCK D
. . I ENLOCK("BATCH") L +^ENG(6914,ENDA):10 I '$T S ENLOCK=0 Q
. . S ^TMP($J,"ENSEL",ENDA)=""
. . I 'ENNX,$P($G(^ENG(6914,ENDA,0)),U,4)="NX" S ENNX=1
. . I 'ENFA,+$$CHKFA^ENFAUTL(ENDA) S ENFA=1
I 'ENLOCK D G EXIT
. W $C(7),!,"Some of the selected equipment is currently being edited"
. W !,"by another process. Please try later."
K ^TMP($J,"ENFLD")
; reserve pseudo entry for edit session
S ENDAT=0
F ENI=90000000001:1:90000000100 L +^ENG(6914,ENI):0 I $T S ENDAT=ENI Q
I 'ENDAT W $C(7),!,"Sorry, unable to reserve space for PM schedule." G EXIT
K ^ENG(6914,ENDAT)
S ^ENG(6914,ENDAT,0)=ENDAT
G FLD^ENEQMED1
EXIT ;
G EXIT^ENEQMED2
;ENEQMED
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENEQMED 3894 printed Apr 09, 2024@20:56:48 Page 2
ENEQMED ;WISC/SAB-Multiple Equipment Edit ;9/24/97
+1 ;;7.0;ENGINEERING**35,45**;;Aug 17, 1993
+2 WRITE !,"Multiple Equipment Edit",!
+3 IF $GET(IO)=""
DO HOME^%ZIS
+4 SET ENEDNX=$DATA(^XUSEC("ENEDNX",DUZ))
+5 KILL ^TMP($JOB)
PO ; get purchase order #
+1 KILL ENPO,ENA,ENX
+2 SET DIR(0)="6914,11"
DO ^DIR
KILL DIR
if Y']""!$DATA(DIRUT)
GOTO EXIT
SET ENX=Y
+3 IF $DATA(^ENG(6914,"M",ENX))
SET ENPO=ENX
GOTO POEND
+4 ; try an alternate format (add/remove station)
+5 SET ENA=$SELECT(ENX["-":$PIECE(ENX,"-",2),1:$PIECE($GET(^DIC(6910,1,0)),U,2)_"-"_ENX)
+6 IF ENA]""
IF $DATA(^ENG(6914,"M",ENA))
SET ENPO=ENA
GOTO POEND
+7 ; show partial matches
+8 SET DIC="^ENG(6914,"
SET ENDX="M"
SET X=ENX
DO IX^ENLIB1
IF X]""
SET ENPO=X
GOTO POEND
+9 IF ENA]""
SET X=ENA
DO IX^ENLIB1
IF X]""
SET ENPO=X
GOTO POEND
+10 WRITE $CHAR(7),!,"No equipment with purchase order # '",ENX,"' found in"
+11 WRITE !,"the Equipment Inventory file."
+12 GOTO PO
POEND ; have purchase order #
+1 ; store and sort equip in tmp
+2 KILL ^TMP($JOB,"ENPO")
+3 SET ENDA=0
FOR
SET ENDA=$ORDER(^ENG(6914,"M",ENPO,ENDA))
if 'ENDA
QUIT
Begin DoDot:1
+4 SET DIC=6914
SET DR="6;1;4"
SET DA=ENDA
SET DIQ="ENQ"
SET DIQ(0)="I"
DO EN^DIQ1
KILL DIQ
+5 FOR Y=6,1,4
IF ENQ(6914,DA,Y,"I")']""
SET ENQ(6914,DA,Y,"I")="?"
+6 SET ^TMP($JOB,"ENPO",ENQ(6914,DA,6,"I"),ENQ(6914,DA,1,"I"),ENQ(6914,DA,4,"I"),DA)=""
+7 KILL ENQ
End DoDot:1
+8 ; build array ENL() of category-manufacturer-model combinations
+9 KILL ENL
SET (ENL,ENC("PO"))=0
+10 SET ENCATI=""
+11 FOR
SET ENCATI=$ORDER(^TMP($JOB,"ENPO",ENCATI))
if ENCATI']""
QUIT
Begin DoDot:1
+12 IF ENCATI
SET DIC=6911
SET DR=".01"
SET DA=ENCATI
SET DIQ="ENQ"
DO EN^DIQ1
KILL DIQ
+13 SET ENCAT=$SELECT(ENCATI:$EXTRACT(ENQ(6911,ENCATI,.01),1,24),1:"unspecified")
KILL ENQ
+14 SET ENMANI=""
+15 FOR
SET ENMANI=$ORDER(^TMP($JOB,"ENPO",ENCATI,ENMANI))
if ENMANI']""
QUIT
Begin DoDot:2
+16 IF ENMANI
SET DIC=6912
SET DR=".01"
SET DA=ENMANI
SET DIQ="ENQ"
DO EN^DIQ1
KILL DIQ
+17 SET ENMAN=$SELECT(ENMANI:$EXTRACT(ENQ(6912,ENMANI,.01),1,24),1:"unspecified")
KILL ENQ
+18 SET ENMOD=""
+19 FOR
SET ENMOD=$ORDER(^TMP($JOB,"ENPO",ENCATI,ENMANI,ENMOD))
if ENMOD']""
QUIT
Begin DoDot:3
+20 SET ENDA=0
SET ENC("LINE")=0
+21 FOR
SET ENDA=$ORDER(^TMP($JOB,"ENPO",ENCATI,ENMANI,ENMOD,ENDA))
if 'ENDA
QUIT
Begin DoDot:4
+22 SET ENC("LINE")=ENC("LINE")+1
End DoDot:4
+23 SET ENL=ENL+1
+24 SET ENL(ENL)=ENCATI_U_ENCAT
+25 SET ENL(ENL)=ENL(ENL)_U_ENMANI_U_ENMAN_U_ENMOD_U
+26 SET ENL(ENL)=ENL(ENL)_$SELECT(ENMOD="?":"unspecified",1:$EXTRACT(ENMOD,1,14))
+27 SET ENL(ENL)=ENL(ENL)_U_ENC("LINE")
+28 SET ENC("PO")=ENC("PO")+ENC("LINE")
End DoDot:3
End DoDot:2
End DoDot:1
+29 SET ENL("MAX")=ENL
+30 ; display array
+31 WRITE @IOF
+32 WRITE ENC("PO")," Equipment Items found with Purchase Order # = ",ENPO
+33 WRITE !,"Line",?6,"Equipment Category",?32,"Manufacturer"
+34 WRITE ?58,"Model",?74,"Count",!
+35 FOR ENL=1:1:ENL("MAX")
Begin DoDot:1
+36 WRITE !,ENL,?6,$PIECE(ENL(ENL),U,2),?32,$PIECE(ENL(ENL),U,4)
+37 WRITE ?58,$PIECE(ENL(ENL),U,6),?74,$PIECE(ENL(ENL),U,7)
End DoDot:1
+38 ; get lines to edit
+39 SET DIR(0)="L^1:"_ENL("MAX")
+40 SET DIR("A")="Select line(s) to edit"
+41 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
SET ENL("SEL")=Y
+42 SET ENC("SEL")=0
+43 FOR ENI=1:1
SET ENL=$PIECE(ENL("SEL"),",",ENI)
if 'ENL
QUIT
SET ENC("SEL")=ENC("SEL")+$PIECE(ENL(ENL),U,7)
+44 WRITE !,ENC("SEL")," Equipment Items will be edited",!
+45 ; save/lock selected equipment
+46 KILL ^TMP($JOB,"ENSEL")
+47 ;lock batch (all) or as-edited
SET ENLOCK("BATCH")=$SELECT(ENC("SEL")>50:0,1:1)
+48 SET ENNX=0
SET ENFA=0
SET ENLOCK=1
+49 FOR ENI=1:1
SET ENL=$PIECE(ENL("SEL"),",",ENI)
if 'ENL
QUIT
Begin DoDot:1
+50 SET ENCATI=$PIECE(ENL(ENL),U,1)
+51 SET ENMANI=$PIECE(ENL(ENL),U,3)
+52 SET ENMOD=$PIECE(ENL(ENL),U,5)
+53 SET ENDA=0
+54 FOR
SET ENDA=$ORDER(^TMP($JOB,"ENPO",ENCATI,ENMANI,ENMOD,ENDA))
if 'ENDA!'ENLOCK
QUIT
Begin DoDot:2
+55 IF ENLOCK("BATCH")
LOCK +^ENG(6914,ENDA):10
IF '$TEST
SET ENLOCK=0
QUIT
+56 SET ^TMP($JOB,"ENSEL",ENDA)=""
+57 IF 'ENNX
IF $PIECE($GET(^ENG(6914,ENDA,0)),U,4)="NX"
SET ENNX=1
+58 IF 'ENFA
IF +$$CHKFA^ENFAUTL(ENDA)
SET ENFA=1
End DoDot:2
End DoDot:1
+59 IF 'ENLOCK
Begin DoDot:1
+60 WRITE $CHAR(7),!,"Some of the selected equipment is currently being edited"
+61 WRITE !,"by another process. Please try later."
End DoDot:1
GOTO EXIT
+62 KILL ^TMP($JOB,"ENFLD")
+63 ; reserve pseudo entry for edit session
+64 SET ENDAT=0
+65 FOR ENI=90000000001:1:90000000100
LOCK +^ENG(6914,ENI):0
IF $TEST
SET ENDAT=ENI
QUIT
+66 IF 'ENDAT
WRITE $CHAR(7),!,"Sorry, unable to reserve space for PM schedule."
GOTO EXIT
+67 KILL ^ENG(6914,ENDAT)
+68 SET ^ENG(6914,ENDAT,0)=ENDAT
+69 GOTO FLD^ENEQMED1
EXIT ;
+1 GOTO EXIT^ENEQMED2
+2 ;ENEQMED
