ENEQ2 ;WIRMFO/DH,SAB-Edit or Display Equipment Records ;4.15.97
;;7.0;ENGINEERING;**14,25,29,35,39**;Aug 17, 1993
;
EQED ;Edit Record Entry Point
S ENEQ("MODE")="E"
S ENEDNX=$D(^XUSEC("ENEDNX",DUZ))
S ENEDPM=$D(^XUSEC("ENEDPM",DUZ))
G SELEQ
;
EQDS ;Display Record Entry Point
S ENEQ("MODE")="D"
G SELEQ
;
SELEQ ; select (and process) equipment for edit or display
; input
; ENEQ("MODE") - switch: 'E' for edit or 'D" for display
; also when ENEQ("MODE")="E"
; ENEDNX - flag, true if user holds key ENEDNX
; ENEDPM - flag, true if user holds key ENEDPM
N IOINLOW,IOINHI D ZIS^ENUTL
S ENEQ("LVL")=0
S END=0
; select and process equipment
F D GETEQ^ENUTL Q:Y<1 S ENDA=+Y D EQP Q:END
; clean up
K:ENEQ("MODE")="E" ENEDNX,ENEDPM
K DIC,END,ENDA,ENEQ,Y
Q
;
EQP ; process one equipment item (display or edit)
; input
; ENDA - ien of equipment item
; ENEQ("MODE") - switch: 'E' for edit or 'D' for Display
; ENEQ("LVL") - recursion level
; IOINHI - bold escape code
; IOINLOW - unbold escape code
; END - flag, true when entire process should stop
; also when ENEQ("MODE")="E"
; ENEDPM - flag; true if user holds ENEDPM key
; ENEDNX - flag; true if user holds ENEDNX key
; output
; END - flag, true when entire process should stop
;
Q:END
; lock equipment
L +^ENG(6914,ENDA):3 I '$T D G EQPX
. W $C(7),!,"Record being edited by someone else. Try later."
. S DIR(0)="E" D ^DIR K DIR S:$D(DTOUT) END=1
; call DJ screen handler
I ENEQ("MODE")="D" S DJSC="ENEQ1D",DJDIS=1
I ENEQ("MODE")="E" S DJSC=$S($P($G(^ENG(6914,ENDA,0)),U,4)'="NX"!ENEDNX:"ENEQ1",1:"ENEQNX1")
S (DJDN,DA)=ENDA
D EN^ENJ W IOINLOW
; PM Data edit (edit mode only)
I ENEQ("MODE")="E",ENEDPM D
. S DIR(0)="Y",DIR("A")="Want to enter/edit PM data",DIR("B")="NO"
. D ^DIR K DIR S:$D(DTOUT) END=1 Q:'Y
. S DIE="^ENG(6914,",DA=ENDA,ENXP=1 D XNPMSE^ENEQPMP
. K ENXP
; display comments & spex (display mode only)
I ENEQ("MODE")="D",$O(^ENG(6914,ENDA,5,0))!$O(^ENG(6914,ENDA,10,0)) D
. W @IOF," ***ENTRY NUMBER:",ENDA,"***"
. ; show COMMENTS (if any)
. I $O(^ENG(6914,ENDA,5,0)) D WP(ENDA,"COMMENTS",5)
. ; show SPEX (if any)
. I '$G(END1),$O(^ENG(6914,ENDA,10,0)) D WP(ENDA,"SPEX",10)
. ; pause
. I '$G(END1) S DIR(0)="E" D ^DIR K DIR S:$D(DTOUT) END=1
. K END1
; unlock equip
L -^ENG(6914,ENDA)
; check for components
I 'END,$O(^ENG(6914,"AE",ENDA,0)) D
. ; ask if components should be listed
. S DIR(0)="Y",DIR("B")="NO"
. S DIR("A")="Equipment has components. Do you want a list (Y/N)"
. D ^DIR K DIR S:$D(DTOUT) END=1 Q:'Y
. ; increment recursion level
. S ENEQ("LVL")=ENEQ("LVL")+1
. ; build list
. K ^TMP("ENC",$J,ENEQ("LVL"))
. S (ENCDA,ENL)=0
. F S ENCDA=$O(^ENG(6914,"AE",ENDA,ENCDA)) Q:'ENCDA D
. . S ENL=ENL+1
. . S ^TMP("ENC",$J,ENEQ("LVL"),ENCDA)=""
. S ^TMP("ENC",$J,ENEQ("LVL"),0)=ENDA_U_ENL
. ; display list
. D LISTC
. ; kill saved list
. K ^TMP("ENC",$J,ENEQ("LVL"))
. ; decrement recursion level
. S ENEQ("LVL")=ENEQ("LVL")-1
EQPX ; clean up
W @IOF
K DA,DIE,DIROUT,DIRUT,DR,DTOUT,DUOUT
K DJDIS,DJD0,DJDN,DJLG,DJSC,DJSW2
K ENCDA,ENL
Q
;
WP(ENDA,ENFIELD,ENNODE) ; display word-processing field
; input
; ENDA - ien of equipment
; ENFIELD - name of field being displayed
; ENNODE - node where field is located in file 6914
; output
; END - (optional) true if user timed-out
; END1 - (optional) true if user entered '^' or timed-out
N ENI
K ^UTILITY($J,"W") S DIWL=1,DIWR=76,DIWF="W"
W !!,IOINHI,ENFIELD_":",IOINLOW
S ENI=0 F S ENI=$O(^ENG(6914,ENDA,ENNODE,ENI)) Q:'ENI D Q:$G(END1)
. I $Y>19 D Q:$G(END1)
. . S DIR(0)="E" D ^DIR K DIR S:$D(DTOUT) END=1 S:'Y END1=1 Q:$G(END1)
. . W @IOF," ***ENTRY NUMBER:",ENDA,"***"
. . W !!,IOINHI,ENFIELD_" (continued):",IOINLOW
. S X=^ENG(6914,ENDA,ENNODE,ENI,0) D ^DIWP
I '$G(END1) D ^DIWW
K ^UTILITY($J,"W"),DIWL,DIWR,DIWF
Q
;
LISTC ; Show/Select-From Component List
; input
; ENEQ("LVL") - recursion level
; ^TMP("ENC",$J,ENEQ("LVL"),0)=parent ien^number of components
; ^TMP("ENC",$J,ENEQ("LVL"),component ien)=""
; END - flag; true if entire process should stop
; output
; END - flag; true if entire process should stop
;
; build screen array from component list
K ^TMP($J,"SCR")
S ENCDA=0,ENC=0
F S ENCDA=$O(^TMP("ENC",$J,ENEQ("LVL"),ENCDA)) Q:'ENCDA D
. S ENC=ENC+1
. S ENX=ENCDA_U_$E($$GET1^DIQ(6914,ENCDA,3),1,20)
. S ENX=ENX_U_$E($$GET1^DIQ(6914,ENCDA,6),1,20)
. S ENX=ENX_U_$E($$GET1^DIQ(6914,ENCDA,24),1,10)
. S ^TMP($J,"SCR",ENC)=ENX
S ENX=^TMP("ENC",$J,ENEQ("LVL"),0)
S ^TMP($J,"SCR")=ENC_U_"Equip. #"_$P(ENX,U)_" Component List"
S ENX="6;10;Entry#^18;20;Mfgr. Equip. Name"
S ENX=ENX_"^40;20;Category^62;10;Location"
S ^TMP($J,"SCR",0)=ENX
LISTC1 ; call list handler
D EN^ENPLS2
; save selected items
K ^TMP("ENC",$J,ENEQ("LVL"),"ACL")
S ENC=0,ENJ="" F S ENJ=$O(ENACL(ENJ)) Q:ENJ="" D
. F ENK=1:1 S ENI=$P(ENACL(ENJ),",",ENK) Q:ENI="" D
. . S ENY=^TMP($J,"SCR",ENI)
. . S ^TMP("ENC",$J,ENEQ("LVL"),"ACL",$P(ENY,U))=$P(ENY,U,5)
. . S ENC=ENC+1
S:ENC ^TMP("ENC",$J,ENEQ("LVL"),"ACL",0)=ENC
; process selected items
S ENDA=0,END(ENEQ("LVL"))=0
F S ENDA=$O(^TMP("ENC",$J,ENEQ("LVL"),"ACL",ENDA)) Q:'ENDA D Q:END(ENEQ("LVL"))
. D EQP Q:END
. Q:'$O(^TMP("ENC",$J,ENEQ("LVL"),"ACL",ENDA)) ; no more left
. ; give user chance to break out of this loop or entire process
. S DIR(0)="FO"
. S DIR("A")="Press RETURN to continue, '^' to exit, or '^^' to stop"
. D ^DIR K DIR
. S:$D(DTOUT)!$D(DIROUT) END=1 S:END!$D(DUOUT) END(ENEQ("LVL"))=1
K END(ENEQ("LVL"))
; restore ENDA to value of parent
S ENDA=$P($G(^TMP("ENC",$J,ENEQ("LVL"),0)),U)
; if items selected then redisplay list
I 'END,$G(^TMP("ENC",$J,ENEQ("LVL"),"ACL",0))>0 G LISTC
LISTCX ; clean up
K ^TMP($J,"SCR"),^TMP("ENC",$J,ENEQ("LVL"),"ACL")
K ENACL,ENC,ENCDA,ENI,ENJ,ENK,ENY,ENX
Q
;ENEQ2
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENEQ2 6078 printed Dec 13, 2024@01:52:23 Page 2
ENEQ2 ;WIRMFO/DH,SAB-Edit or Display Equipment Records ;4.15.97
+1 ;;7.0;ENGINEERING;**14,25,29,35,39**;Aug 17, 1993
+2 ;
EQED ;Edit Record Entry Point
+1 SET ENEQ("MODE")="E"
+2 SET ENEDNX=$DATA(^XUSEC("ENEDNX",DUZ))
+3 SET ENEDPM=$DATA(^XUSEC("ENEDPM",DUZ))
+4 GOTO SELEQ
+5 ;
EQDS ;Display Record Entry Point
+1 SET ENEQ("MODE")="D"
+2 GOTO SELEQ
+3 ;
SELEQ ; select (and process) equipment for edit or display
+1 ; input
+2 ; ENEQ("MODE") - switch: 'E' for edit or 'D" for display
+3 ; also when ENEQ("MODE")="E"
+4 ; ENEDNX - flag, true if user holds key ENEDNX
+5 ; ENEDPM - flag, true if user holds key ENEDPM
+6 NEW IOINLOW,IOINHI
DO ZIS^ENUTL
+7 SET ENEQ("LVL")=0
+8 SET END=0
+9 ; select and process equipment
+10 FOR
DO GETEQ^ENUTL
if Y<1
QUIT
SET ENDA=+Y
DO EQP
if END
QUIT
+11 ; clean up
+12 if ENEQ("MODE")="E"
KILL ENEDNX,ENEDPM
+13 KILL DIC,END,ENDA,ENEQ,Y
+14 QUIT
+15 ;
EQP ; process one equipment item (display or edit)
+1 ; input
+2 ; ENDA - ien of equipment item
+3 ; ENEQ("MODE") - switch: 'E' for edit or 'D' for Display
+4 ; ENEQ("LVL") - recursion level
+5 ; IOINHI - bold escape code
+6 ; IOINLOW - unbold escape code
+7 ; END - flag, true when entire process should stop
+8 ; also when ENEQ("MODE")="E"
+9 ; ENEDPM - flag; true if user holds ENEDPM key
+10 ; ENEDNX - flag; true if user holds ENEDNX key
+11 ; output
+12 ; END - flag, true when entire process should stop
+13 ;
+14 if END
QUIT
+15 ; lock equipment
+16 LOCK +^ENG(6914,ENDA):3
IF '$TEST
Begin DoDot:1
+17 WRITE $CHAR(7),!,"Record being edited by someone else. Try later."
+18 SET DIR(0)="E"
DO ^DIR
KILL DIR
if $DATA(DTOUT)
SET END=1
End DoDot:1
GOTO EQPX
+19 ; call DJ screen handler
+20 IF ENEQ("MODE")="D"
SET DJSC="ENEQ1D"
SET DJDIS=1
+21 IF ENEQ("MODE")="E"
SET DJSC=$SELECT($PIECE($GET(^ENG(6914,ENDA,0)),U,4)'="NX"!ENEDNX:"ENEQ1",1:"ENEQNX1")
+22 SET (DJDN,DA)=ENDA
+23 DO EN^ENJ
WRITE IOINLOW
+24 ; PM Data edit (edit mode only)
+25 IF ENEQ("MODE")="E"
IF ENEDPM
Begin DoDot:1
+26 SET DIR(0)="Y"
SET DIR("A")="Want to enter/edit PM data"
SET DIR("B")="NO"
+27 DO ^DIR
KILL DIR
if $DATA(DTOUT)
SET END=1
if 'Y
QUIT
+28 SET DIE="^ENG(6914,"
SET DA=ENDA
SET ENXP=1
DO XNPMSE^ENEQPMP
+29 KILL ENXP
End DoDot:1
+30 ; display comments & spex (display mode only)
+31 IF ENEQ("MODE")="D"
IF $ORDER(^ENG(6914,ENDA,5,0))!$ORDER(^ENG(6914,ENDA,10,0))
Begin DoDot:1
+32 WRITE @IOF," ***ENTRY NUMBER:",ENDA,"***"
+33 ; show COMMENTS (if any)
+34 IF $ORDER(^ENG(6914,ENDA,5,0))
DO WP(ENDA,"COMMENTS",5)
+35 ; show SPEX (if any)
+36 IF '$GET(END1)
IF $ORDER(^ENG(6914,ENDA,10,0))
DO WP(ENDA,"SPEX",10)
+37 ; pause
+38 IF '$GET(END1)
SET DIR(0)="E"
DO ^DIR
KILL DIR
if $DATA(DTOUT)
SET END=1
+39 KILL END1
End DoDot:1
+40 ; unlock equip
+41 LOCK -^ENG(6914,ENDA)
+42 ; check for components
+43 IF 'END
IF $ORDER(^ENG(6914,"AE",ENDA,0))
Begin DoDot:1
+44 ; ask if components should be listed
+45 SET DIR(0)="Y"
SET DIR("B")="NO"
+46 SET DIR("A")="Equipment has components. Do you want a list (Y/N)"
+47 DO ^DIR
KILL DIR
if $DATA(DTOUT)
SET END=1
if 'Y
QUIT
+48 ; increment recursion level
+49 SET ENEQ("LVL")=ENEQ("LVL")+1
+50 ; build list
+51 KILL ^TMP("ENC",$JOB,ENEQ("LVL"))
+52 SET (ENCDA,ENL)=0
+53 FOR
SET ENCDA=$ORDER(^ENG(6914,"AE",ENDA,ENCDA))
if 'ENCDA
QUIT
Begin DoDot:2
+54 SET ENL=ENL+1
+55 SET ^TMP("ENC",$JOB,ENEQ("LVL"),ENCDA)=""
End DoDot:2
+56 SET ^TMP("ENC",$JOB,ENEQ("LVL"),0)=ENDA_U_ENL
+57 ; display list
+58 DO LISTC
+59 ; kill saved list
+60 KILL ^TMP("ENC",$JOB,ENEQ("LVL"))
+61 ; decrement recursion level
+62 SET ENEQ("LVL")=ENEQ("LVL")-1
End DoDot:1
EQPX ; clean up
+1 WRITE @IOF
+2 KILL DA,DIE,DIROUT,DIRUT,DR,DTOUT,DUOUT
+3 KILL DJDIS,DJD0,DJDN,DJLG,DJSC,DJSW2
+4 KILL ENCDA,ENL
+5 QUIT
+6 ;
WP(ENDA,ENFIELD,ENNODE) ; display word-processing field
+1 ; input
+2 ; ENDA - ien of equipment
+3 ; ENFIELD - name of field being displayed
+4 ; ENNODE - node where field is located in file 6914
+5 ; output
+6 ; END - (optional) true if user timed-out
+7 ; END1 - (optional) true if user entered '^' or timed-out
+8 NEW ENI
+9 KILL ^UTILITY($JOB,"W")
SET DIWL=1
SET DIWR=76
SET DIWF="W"
+10 WRITE !!,IOINHI,ENFIELD_":",IOINLOW
+11 SET ENI=0
FOR
SET ENI=$ORDER(^ENG(6914,ENDA,ENNODE,ENI))
if 'ENI
QUIT
Begin DoDot:1
+12 IF $Y>19
Begin DoDot:2
+13 SET DIR(0)="E"
DO ^DIR
KILL DIR
if $DATA(DTOUT)
SET END=1
if 'Y
SET END1=1
if $GET(END1)
QUIT
+14 WRITE @IOF," ***ENTRY NUMBER:",ENDA,"***"
+15 WRITE !!,IOINHI,ENFIELD_" (continued):",IOINLOW
End DoDot:2
if $GET(END1)
QUIT
+16 SET X=^ENG(6914,ENDA,ENNODE,ENI,0)
DO ^DIWP
End DoDot:1
if $GET(END1)
QUIT
+17 IF '$GET(END1)
DO ^DIWW
+18 KILL ^UTILITY($JOB,"W"),DIWL,DIWR,DIWF
+19 QUIT
+20 ;
LISTC ; Show/Select-From Component List
+1 ; input
+2 ; ENEQ("LVL") - recursion level
+3 ; ^TMP("ENC",$J,ENEQ("LVL"),0)=parent ien^number of components
+4 ; ^TMP("ENC",$J,ENEQ("LVL"),component ien)=""
+5 ; END - flag; true if entire process should stop
+6 ; output
+7 ; END - flag; true if entire process should stop
+8 ;
+9 ; build screen array from component list
+10 KILL ^TMP($JOB,"SCR")
+11 SET ENCDA=0
SET ENC=0
+12 FOR
SET ENCDA=$ORDER(^TMP("ENC",$JOB,ENEQ("LVL"),ENCDA))
if 'ENCDA
QUIT
Begin DoDot:1
+13 SET ENC=ENC+1
+14 SET ENX=ENCDA_U_$EXTRACT($$GET1^DIQ(6914,ENCDA,3),1,20)
+15 SET ENX=ENX_U_$EXTRACT($$GET1^DIQ(6914,ENCDA,6),1,20)
+16 SET ENX=ENX_U_$EXTRACT($$GET1^DIQ(6914,ENCDA,24),1,10)
+17 SET ^TMP($JOB,"SCR",ENC)=ENX
End DoDot:1
+18 SET ENX=^TMP("ENC",$JOB,ENEQ("LVL"),0)
+19 SET ^TMP($JOB,"SCR")=ENC_U_"Equip. #"_$PIECE(ENX,U)_" Component List"
+20 SET ENX="6;10;Entry#^18;20;Mfgr. Equip. Name"
+21 SET ENX=ENX_"^40;20;Category^62;10;Location"
+22 SET ^TMP($JOB,"SCR",0)=ENX
LISTC1 ; call list handler
+1 DO EN^ENPLS2
+2 ; save selected items
+3 KILL ^TMP("ENC",$JOB,ENEQ("LVL"),"ACL")
+4 SET ENC=0
SET ENJ=""
FOR
SET ENJ=$ORDER(ENACL(ENJ))
if ENJ=""
QUIT
Begin DoDot:1
+5 FOR ENK=1:1
SET ENI=$PIECE(ENACL(ENJ),",",ENK)
if ENI=""
QUIT
Begin DoDot:2
+6 SET ENY=^TMP($JOB,"SCR",ENI)
+7 SET ^TMP("ENC",$JOB,ENEQ("LVL"),"ACL",$PIECE(ENY,U))=$PIECE(ENY,U,5)
+8 SET ENC=ENC+1
End DoDot:2
End DoDot:1
+9 if ENC
SET ^TMP("ENC",$JOB,ENEQ("LVL"),"ACL",0)=ENC
+10 ; process selected items
+11 SET ENDA=0
SET END(ENEQ("LVL"))=0
+12 FOR
SET ENDA=$ORDER(^TMP("ENC",$JOB,ENEQ("LVL"),"ACL",ENDA))
if 'ENDA
QUIT
Begin DoDot:1
+13 DO EQP
if END
QUIT
+14 ; no more left
if '$ORDER(^TMP("ENC",$JOB,ENEQ("LVL"),"ACL",ENDA))
QUIT
+15 ; give user chance to break out of this loop or entire process
+16 SET DIR(0)="FO"
+17 SET DIR("A")="Press RETURN to continue, '^' to exit, or '^^' to stop"
+18 DO ^DIR
KILL DIR
+19 if $DATA(DTOUT)!$DATA(DIROUT)
SET END=1
if END!$DATA(DUOUT)
SET END(ENEQ("LVL"))=1
End DoDot:1
if END(ENEQ("LVL"))
QUIT
+20 KILL END(ENEQ("LVL"))
+21 ; restore ENDA to value of parent
+22 SET ENDA=$PIECE($GET(^TMP("ENC",$JOB,ENEQ("LVL"),0)),U)
+23 ; if items selected then redisplay list
+24 IF 'END
IF $GET(^TMP("ENC",$JOB,ENEQ("LVL"),"ACL",0))>0
GOTO LISTC
LISTCX ; clean up
+1 KILL ^TMP($JOB,"SCR"),^TMP("ENC",$JOB,ENEQ("LVL"),"ACL")
+2 KILL ENACL,ENC,ENCDA,ENI,ENJ,ENK,ENY,ENX
+3 QUIT
+4 ;ENEQ2
