- ENEQMED3 ;(WASH ISC)/SAB-EQUIPMENT MULTIPLE EDIT, REPORT; 9.24.97
- ;;7.0;ENGINEERING;**35,39,45**;Aug 17, 1993
- EN ;
- ; Input Variables
- ; ^TMP($J,"ENFLD",field number) modified fields array
- ; ^TMP($J,"ENSEL",equip ien) selected equipment array
- ; ^TMP($J,"ENCOM", word processing array for comments
- ; ^TMP($J,"ENSPEX", word processing array for spex
- ; ^TMP($J,"ENLCK",equip ien) equipment that couldn't be locked/updated
- S %ZIS="Q" D ^%ZIS Q:POP
- I $D(IO("Q")) D Q
- . S ZTRTN="QEN^ENEQMED3",ZTDESC="Multiple Edit of Equipment Report"
- . S ZTSAVE("^TMP($J,""ENFLD"",")="",ZTSAVE("^TMP($J,""ENSEL"",")=""
- . S ZTSAVE("^TMP($J,""ENCOM"",")="",ZTSAVE("^TMP($J,""ENSPEX"",")=""
- . S ZTSAVE("^TMP($J,""ENLCK"",")=""
- . D ^%ZTLOAD,HOME^%ZIS K ZTSK
- QEN ; queued entry
- U IO
- S (END,ENPG)=0 S Y=$P(DT,".") D DD^%DT S ENDT=Y
- S ENHDR2="Edited Field(s) New Value"
- S ENDASH="",$P(ENDASH,"-",IOM+1)="" D HD
- S ENFLD=0
- F S ENFLD=$O(^TMP($J,"ENFLD",ENFLD)) Q:'ENFLD D:$Y+3>IOSL HD Q:END D
- . I ENFLD=30 W !,"PM DATA" Q
- . I ENFLD=40 W !,"COMMENTS" D Q
- . . S DIWL=36,DIWR=75,DIWF="W|"
- . . S ENI=0
- . . F S ENI=$O(^TMP($J,"ENCOM",ENI)) Q:'ENI S X=^(ENI,0) D ^DIWP
- . . D ^DIWW
- . . K DIWL,DIWR,DIWF,X
- . I ENFLD=70 W !,"SPEX" D Q
- . . S DIWL=36,DIWR=75,DIWF="W|"
- . . S ENI=0
- . . F S ENI=$O(^TMP($J,"ENSPEX",ENI)) Q:'ENI S X=^(ENI,0) D ^DIWP
- . . D ^DIWW
- . . K DIWL,DIWR,DIWF,X
- . S ENVALE=$P($G(^TMP($J,"ENFLD",ENFLD)),U,2)
- . W !,$$GET1^DID(6914,ENFLD,"","LABEL"),?35
- . W $S(ENVALE]"":$E(ENVALE,1,40),1:"(individually specified for each item)")
- G:END EXIT
- I $D(^TMP($J,"ENLCK")) D
- . S ENHDR2="List of Selected Equipment that was NOT Modified."
- . I $Y+8>IOSL D HD
- . E W !!,ENHDR2
- . W !," Some of the selected equipment could not be updated because it"
- . W !," was being edited by another process. This equipment will need"
- . W !," to be edited to make the desired changes."
- . S ENDA=0,ENI=0
- . F S ENDA=$O(^TMP($J,"ENLCK",ENDA)) Q:'ENDA D Q:END
- . . I '(ENI#6) D:$Y+3>IOSL HD Q:END W !
- . . W ?(ENI#6*12),ENDA
- . . S ENI=ENI+1
- S ENHDR2="List of Modified Equipment"
- I $Y+5>IOSL D HD
- E W !!,ENHDR2
- S ENDA=0,ENI=0
- F S ENDA=$O(^TMP($J,"ENSEL",ENDA)) Q:'ENDA D Q:END
- . Q:$D(^TMP($J,"ENLCK",ENDA)) ; could not be locked/updated
- . I '(ENI#6) D:$Y+3>IOSL HD Q:END W !
- . W ?(ENI#6*12),ENDA
- . S ENI=ENI+1
- EXIT I $D(ZTQUEUED) S ZTREQ="Q" K ^TMP($J)
- K DA,DIC,DIQ,DR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
- K END,ENDA,ENDASH,ENDIQ,ENDT,ENFLD,ENHDR2,ENI,ENPG,ENVALE
- D ^%ZISC
- Q
- HD ; header
- I $E(IOST,1,2)="C-",ENPG S DIR(0)="E" D ^DIR K DIR I 'Y S END=1 Q
- I $E(IOST,1,2)="C-"!ENPG W @IOF
- S ENPG=ENPG+1
- S $X=0
- W "Multiple Edit of Equipment Report",?50,ENDT,?70,"page ",ENPG
- W !,ENDASH,!
- W !,ENHDR2,!
- Q
- ;ENEQMED3
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENEQMED3 2840 printed Jan 18, 2025@02:53:46 Page 2
- ENEQMED3 ;(WASH ISC)/SAB-EQUIPMENT MULTIPLE EDIT, REPORT; 9.24.97
- +1 ;;7.0;ENGINEERING;**35,39,45**;Aug 17, 1993
- EN ;
- +1 ; Input Variables
- +2 ; ^TMP($J,"ENFLD",field number) modified fields array
- +3 ; ^TMP($J,"ENSEL",equip ien) selected equipment array
- +4 ; ^TMP($J,"ENCOM", word processing array for comments
- +5 ; ^TMP($J,"ENSPEX", word processing array for spex
- +6 ; ^TMP($J,"ENLCK",equip ien) equipment that couldn't be locked/updated
- +7 SET %ZIS="Q"
- DO ^%ZIS
- if POP
- QUIT
- +8 IF $DATA(IO("Q"))
- Begin DoDot:1
- +9 SET ZTRTN="QEN^ENEQMED3"
- SET ZTDESC="Multiple Edit of Equipment Report"
- +10 SET ZTSAVE("^TMP($J,""ENFLD"",")=""
- SET ZTSAVE("^TMP($J,""ENSEL"",")=""
- +11 SET ZTSAVE("^TMP($J,""ENCOM"",")=""
- SET ZTSAVE("^TMP($J,""ENSPEX"",")=""
- +12 SET ZTSAVE("^TMP($J,""ENLCK"",")=""
- +13 DO ^%ZTLOAD
- DO HOME^%ZIS
- KILL ZTSK
- End DoDot:1
- QUIT
- QEN ; queued entry
- +1 USE IO
- +2 SET (END,ENPG)=0
- SET Y=$PIECE(DT,".")
- DO DD^%DT
- SET ENDT=Y
- +3 SET ENHDR2="Edited Field(s) New Value"
- +4 SET ENDASH=""
- SET $PIECE(ENDASH,"-",IOM+1)=""
- DO HD
- +5 SET ENFLD=0
- +6 FOR
- SET ENFLD=$ORDER(^TMP($JOB,"ENFLD",ENFLD))
- if 'ENFLD
- QUIT
- if $Y+3>IOSL
- DO HD
- if END
- QUIT
- Begin DoDot:1
- +7 IF ENFLD=30
- WRITE !,"PM DATA"
- QUIT
- +8 IF ENFLD=40
- WRITE !,"COMMENTS"
- Begin DoDot:2
- +9 SET DIWL=36
- SET DIWR=75
- SET DIWF="W|"
- +10 SET ENI=0
- +11 FOR
- SET ENI=$ORDER(^TMP($JOB,"ENCOM",ENI))
- if 'ENI
- QUIT
- SET X=^(ENI,0)
- DO ^DIWP
- +12 DO ^DIWW
- +13 KILL DIWL,DIWR,DIWF,X
- End DoDot:2
- QUIT
- +14 IF ENFLD=70
- WRITE !,"SPEX"
- Begin DoDot:2
- +15 SET DIWL=36
- SET DIWR=75
- SET DIWF="W|"
- +16 SET ENI=0
- +17 FOR
- SET ENI=$ORDER(^TMP($JOB,"ENSPEX",ENI))
- if 'ENI
- QUIT
- SET X=^(ENI,0)
- DO ^DIWP
- +18 DO ^DIWW
- +19 KILL DIWL,DIWR,DIWF,X
- End DoDot:2
- QUIT
- +20 SET ENVALE=$PIECE($GET(^TMP($JOB,"ENFLD",ENFLD)),U,2)
- +21 WRITE !,$$GET1^DID(6914,ENFLD,"","LABEL"),?35
- +22 WRITE $SELECT(ENVALE]"":$EXTRACT(ENVALE,1,40),1:"(individually specified for each item)")
- End DoDot:1
- +23 if END
- GOTO EXIT
- +24 IF $DATA(^TMP($JOB,"ENLCK"))
- Begin DoDot:1
- +25 SET ENHDR2="List of Selected Equipment that was NOT Modified."
- +26 IF $Y+8>IOSL
- DO HD
- +27 IF '$TEST
- WRITE !!,ENHDR2
- +28 WRITE !," Some of the selected equipment could not be updated because it"
- +29 WRITE !," was being edited by another process. This equipment will need"
- +30 WRITE !," to be edited to make the desired changes."
- +31 SET ENDA=0
- SET ENI=0
- +32 FOR
- SET ENDA=$ORDER(^TMP($JOB,"ENLCK",ENDA))
- if 'ENDA
- QUIT
- Begin DoDot:2
- +33 IF '(ENI#6)
- if $Y+3>IOSL
- DO HD
- if END
- QUIT
- WRITE !
- +34 WRITE ?(ENI#6*12),ENDA
- +35 SET ENI=ENI+1
- End DoDot:2
- if END
- QUIT
- End DoDot:1
- +36 SET ENHDR2="List of Modified Equipment"
- +37 IF $Y+5>IOSL
- DO HD
- +38 IF '$TEST
- WRITE !!,ENHDR2
- +39 SET ENDA=0
- SET ENI=0
- +40 FOR
- SET ENDA=$ORDER(^TMP($JOB,"ENSEL",ENDA))
- if 'ENDA
- QUIT
- Begin DoDot:1
- +41 ; could not be locked/updated
- if $DATA(^TMP($JOB,"ENLCK",ENDA))
- QUIT
- +42 IF '(ENI#6)
- if $Y+3>IOSL
- DO HD
- if END
- QUIT
- WRITE !
- +43 WRITE ?(ENI#6*12),ENDA
- +44 SET ENI=ENI+1
- End DoDot:1
- if END
- QUIT
- EXIT IF $DATA(ZTQUEUED)
- SET ZTREQ="Q"
- KILL ^TMP($JOB)
- +1 KILL DA,DIC,DIQ,DR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
- +2 KILL END,ENDA,ENDASH,ENDIQ,ENDT,ENFLD,ENHDR2,ENI,ENPG,ENVALE
- +3 DO ^%ZISC
- +4 QUIT
- HD ; header
- +1 IF $EXTRACT(IOST,1,2)="C-"
- IF ENPG
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET END=1
- QUIT
- +2 IF $EXTRACT(IOST,1,2)="C-"!ENPG
- WRITE @IOF
- +3 SET ENPG=ENPG+1
- +4 SET $X=0
- +5 WRITE "Multiple Edit of Equipment Report",?50,ENDT,?70,"page ",ENPG
- +6 WRITE !,ENDASH,!
- +7 WRITE !,ENHDR2,!
- +8 QUIT
- +9 ;ENEQMED3