ENEWOD1 ;(WASH ISC)/DH-Display Electronic Work Order ;1.23.97
;;7.0;ENGINEERING;**35**;Aug 17, 1993
TOP ; Physical print
; Get BOLD and UNBOLD
N IOINLOW,IOINHI,IOINORM D ZIS^ENUTL
;
N I,J,X
W:$E(IOST,1,2)="C-" @IOF
S $X=1 W ?28 D W("ELECTRONIC WORK REQUEST")
W ! D W(" 1) ") W "WORK ORDER #: " D W(EN(1))
W ?41 D W(" 2) ") W "REQ DATE: " S X=EN(2) D PDT
W ! D W(" 3) ") W "REQ MODE: " D W(EN(3)) W ?41 D W(" 4) ") W "LOCATION: " D W(EN(4))
W ! D W(" 5) ") W "BED #: " D W(EN(5))
W ?41 D W(" 6) ") W $S(ENDSTAT=35.2:"PM STATUS: ",1:"STATUS: ") D W(EN(6))
W ! D W(" 7) ") W "TASK DESC: " D W(EN(7))
W ! D W(" 8) ") W "CONTACT: " D W(EN(8)) W ?41 D W(" 9) ") W "PHONE: " D W(EN(9))
W ! D W("10) ") W "ENTERED BY: " D W(EN(10)) W ?41 D W("11) ") W "SHOP: " D W(EN(11))
W ! D W("12) ") W "PRIORITY: " D W(EN(12)) W ?41 D W("13) ") W "DATE ASSIGNED: " S X=EN(13) D PDT
W ! D W("14) ") W "EQUIP ID#: " D W(EN(14)) W ?41 D W("15) ") W "LOCAL ID: " D W(EN(15))
W ! D W("16) ") W "EQUIP CAT: " D W(EN(16)) W ?41 D W("17) ") W "MFGR: " D W(EN(17))
W ! D W("18) ") W "MODEL: " D W(EN(18)) W ?41 D W("19) ") W "SERIAL #: " D W(EN(19))
W ! D W("20) ") W "OWNER/DEPT: " D W(EN(20)) W ?49 D W("21) ") W "PM #: " D W(EN(21))
W ! D W("22) ") W "DATE COMPLETE: " S X=EN(22) D PDT
W ! D W("23) ") W "WORK PERFORMED: "
I EN(23)]"" D
. I $L(EN(23))<61 D W(EN(23)) Q
. K ^UTILITY($J,"W") S X=EN(23),DIWL=1,DIWR=60,DIWF="" D ^DIWP
. S I=0 F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:'I W:I>1 !,?20 D W(^(I,0))
W ! D W("24) ") W "COMMENTS: "
WCO I $D(^ENG(6920,DA,6)) S DIWL=5,DIWR=(IOM-5),DIWF="|",(X,ENX)=0 D G:ENX="^" KILL
. K ^UTILITY($J,"W")
. S ENNX=0 F S ENNX=$O(^ENG(6920,DA,6,ENNX)) Q:ENNX'>0 S X=^(ENNX,0) D ^DIWP
. W IOINHI S ENNX=0 F S ENNX=$O(^UTILITY($J,"W",DIWL,ENNX)) Q:'ENNX W !,?DIWL,^(ENNX,0) I (IOSL-$Y)'>1 D Q:ENX="^"
.. W IOINLOW D HOLD W:ENX'="^" IOINHI
. W IOINLOW
BOTM ; Bottom of page
W ! D:(IOSL-$Y)'>1 HOLD K X I EN(14)]"",$D(^ENG(6914,EN(14),2)) S X=$P(^(2),U,5) I X]"" W "WARRANTY EXPIRATION: ",IOINHI W:+X>+DT "**" W $E(X,4,5),"/",$E(X,6,7),"/",$E(X,2,3) W:+X>+DT "**" W IOINLOW,?41
S ENORIG=$P(^ENG(6920,DA,0),U,6) I ENORIG]"",ENORIG'=$P(^(0),U) W "(Original Work Order: "_ENORIG_")"
I EN(14)>0 D
. S ENUSE=$$GET1^DIQ(6914,EN(14),20) I ENUSE]"","TURNED IN^LOST OR STOLEN"[ENUSE W ! D:(IOSL-$Y)'>1 HOLD W "USE STATUS of this equipment is "_ENUSE_" and may need to be edited."
. S I=9999999999 F S I=$O(^ENG(6920,"G",EN(14),I),-1) Q:'I!($G(X("HA"))) D
.. Q:$E($P($G(^ENG(6920,I,0)),U),1,3)="PM-"
.. Q:$P($G(^ENG(6920,I,5)),U,2)]"" ;Closed work order
.. S J=0 F S J=$O(^ENG(6920,I,8,J)) Q:'J!($G(X("HA"))) I $P(^ENG(6920,I,8,J,0),U)=8 S X("HA")=I
. I $G(X("HA"))>0 W ! D:(IOSL-$Y)'>1 HOLD W "Open HAZARD ALERT for this equipment. Work order: "_$P(^ENG(6920,X("HA"),0),U)_"."
Q
;
PDT I X]"" S Y=X X ^DD("DD") D W(Y)
Q
;
W(ENDATA) ; Bold ENDATA
N X
S X=$X W IOINHI S $X=X W ENDATA
S X=$X W IOINLOW S $X=X
Q
;
HOLD I $E(IOST,1,2)="C-" W !," (Press <RETURN> to continue, '^' to escape...)" R ENX:DTIME S $Y=0 Q
W @IOF,"(Work Order: "_$P(^ENG(6920,DA,0),U)_")"
Q
;
KILL K EN,ENNX,ENORIG,ENUSE,ENX
Q
;ENEWOD1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENEWOD1 3244 printed Apr 09, 2024@20:58:38 Page 2
ENEWOD1 ;(WASH ISC)/DH-Display Electronic Work Order ;1.23.97
+1 ;;7.0;ENGINEERING;**35**;Aug 17, 1993
TOP ; Physical print
+1 ; Get BOLD and UNBOLD
+2 NEW IOINLOW,IOINHI,IOINORM
DO ZIS^ENUTL
+3 ;
+4 NEW I,J,X
+5 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+6 SET $X=1
WRITE ?28
DO W("ELECTRONIC WORK REQUEST")
+7 WRITE !
DO W(" 1) ")
WRITE "WORK ORDER #: "
DO W(EN(1))
+8 WRITE ?41
DO W(" 2) ")
WRITE "REQ DATE: "
SET X=EN(2)
DO PDT
+9 WRITE !
DO W(" 3) ")
WRITE "REQ MODE: "
DO W(EN(3))
WRITE ?41
DO W(" 4) ")
WRITE "LOCATION: "
DO W(EN(4))
+10 WRITE !
DO W(" 5) ")
WRITE "BED #: "
DO W(EN(5))
+11 WRITE ?41
DO W(" 6) ")
WRITE $SELECT(ENDSTAT=35.2:"PM STATUS: ",1:"STATUS: ")
DO W(EN(6))
+12 WRITE !
DO W(" 7) ")
WRITE "TASK DESC: "
DO W(EN(7))
+13 WRITE !
DO W(" 8) ")
WRITE "CONTACT: "
DO W(EN(8))
WRITE ?41
DO W(" 9) ")
WRITE "PHONE: "
DO W(EN(9))
+14 WRITE !
DO W("10) ")
WRITE "ENTERED BY: "
DO W(EN(10))
WRITE ?41
DO W("11) ")
WRITE "SHOP: "
DO W(EN(11))
+15 WRITE !
DO W("12) ")
WRITE "PRIORITY: "
DO W(EN(12))
WRITE ?41
DO W("13) ")
WRITE "DATE ASSIGNED: "
SET X=EN(13)
DO PDT
+16 WRITE !
DO W("14) ")
WRITE "EQUIP ID#: "
DO W(EN(14))
WRITE ?41
DO W("15) ")
WRITE "LOCAL ID: "
DO W(EN(15))
+17 WRITE !
DO W("16) ")
WRITE "EQUIP CAT: "
DO W(EN(16))
WRITE ?41
DO W("17) ")
WRITE "MFGR: "
DO W(EN(17))
+18 WRITE !
DO W("18) ")
WRITE "MODEL: "
DO W(EN(18))
WRITE ?41
DO W("19) ")
WRITE "SERIAL #: "
DO W(EN(19))
+19 WRITE !
DO W("20) ")
WRITE "OWNER/DEPT: "
DO W(EN(20))
WRITE ?49
DO W("21) ")
WRITE "PM #: "
DO W(EN(21))
+20 WRITE !
DO W("22) ")
WRITE "DATE COMPLETE: "
SET X=EN(22)
DO PDT
+21 WRITE !
DO W("23) ")
WRITE "WORK PERFORMED: "
+22 IF EN(23)]""
Begin DoDot:1
+23 IF $LENGTH(EN(23))<61
DO W(EN(23))
QUIT
+24 KILL ^UTILITY($JOB,"W")
SET X=EN(23)
SET DIWL=1
SET DIWR=60
SET DIWF=""
DO ^DIWP
+25 SET I=0
FOR
SET I=$ORDER(^UTILITY($JOB,"W",DIWL,I))
if 'I
QUIT
if I>1
WRITE !,?20
DO W(^(I,0))
End DoDot:1
+26 WRITE !
DO W("24) ")
WRITE "COMMENTS: "
WCO IF $DATA(^ENG(6920,DA,6))
SET DIWL=5
SET DIWR=(IOM-5)
SET DIWF="|"
SET (X,ENX)=0
Begin DoDot:1
+1 KILL ^UTILITY($JOB,"W")
+2 SET ENNX=0
FOR
SET ENNX=$ORDER(^ENG(6920,DA,6,ENNX))
if ENNX'>0
QUIT
SET X=^(ENNX,0)
DO ^DIWP
+3 WRITE IOINHI
SET ENNX=0
FOR
SET ENNX=$ORDER(^UTILITY($JOB,"W",DIWL,ENNX))
if 'ENNX
QUIT
WRITE !,?DIWL,^(ENNX,0)
IF (IOSL-$Y)'>1
Begin DoDot:2
+4 WRITE IOINLOW
DO HOLD
if ENX'="^"
WRITE IOINHI
End DoDot:2
if ENX="^"
QUIT
+5 WRITE IOINLOW
End DoDot:1
if ENX="^"
GOTO KILL
BOTM ; Bottom of page
+1 WRITE !
if (IOSL-$Y)'>1
DO HOLD
KILL X
IF EN(14)]""
IF $DATA(^ENG(6914,EN(14),2))
SET X=$PIECE(^(2),U,5)
IF X]""
WRITE "WARRANTY EXPIRATION: ",IOINHI
if +X>+DT
WRITE "**"
WRITE $EXTRACT(X,4,5),"/",$EXTRACT(X,6,7),"/",$EXTRACT(X,2,3)
if +X>+DT
WRITE "**"
WRITE IOINLOW,?41
+2 SET ENORIG=$PIECE(^ENG(6920,DA,0),U,6)
IF ENORIG]""
IF ENORIG'=$PIECE(^(0),U)
WRITE "(Original Work Order: "_ENORIG_")"
+3 IF EN(14)>0
Begin DoDot:1
+4 SET ENUSE=$$GET1^DIQ(6914,EN(14),20)
IF ENUSE]""
IF "TURNED IN^LOST OR STOLEN"[ENUSE
WRITE !
if (IOSL-$Y)'>1
DO HOLD
WRITE "USE STATUS of this equipment is "_ENUSE_" and may need to be edited."
+5 SET I=9999999999
FOR
SET I=$ORDER(^ENG(6920,"G",EN(14),I),-1)
if 'I!($GET(X("HA")))
QUIT
Begin DoDot:2
+6 if $EXTRACT($PIECE($GET(^ENG(6920,I,0)),U),1,3)="PM-"
QUIT
+7 ;Closed work order
if $PIECE($GET(^ENG(6920,I,5)),U,2)]""
QUIT
+8 SET J=0
FOR
SET J=$ORDER(^ENG(6920,I,8,J))
if 'J!($GET(X("HA")))
QUIT
IF $PIECE(^ENG(6920,I,8,J,0),U)=8
SET X("HA")=I
End DoDot:2
+9 IF $GET(X("HA"))>0
WRITE !
if (IOSL-$Y)'>1
DO HOLD
WRITE "Open HAZARD ALERT for this equipment. Work order: "_$PIECE(^ENG(6920,X("HA"),0),U)_"."
End DoDot:1
+10 QUIT
+11 ;
PDT IF X]""
SET Y=X
XECUTE ^DD("DD")
DO W(Y)
+1 QUIT
+2 ;
W(ENDATA) ; Bold ENDATA
+1 NEW X
+2 SET X=$X
WRITE IOINHI
SET $X=X
WRITE ENDATA
+3 SET X=$X
WRITE IOINLOW
SET $X=X
+4 QUIT
+5 ;
HOLD IF $EXTRACT(IOST,1,2)="C-"
WRITE !," (Press <RETURN> to continue, '^' to escape...)"
READ ENX:DTIME
SET $Y=0
QUIT
+1 WRITE @IOF,"(Work Order: "_$PIECE(^ENG(6920,DA,0),U)_")"
+2 QUIT
+3 ;
KILL KILL EN,ENNX,ENORIG,ENUSE,ENX
+1 QUIT
+2 ;ENEWOD1
