- 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 Dec 13, 2024@01:52:30 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