- ENWOD2 ;(WASH ISC)/DLM/DH-Formatted Work Order Display ;12.10.97
- ;;7.0;ENGINEERING;**15,35,42,43,47**;Aug 17, 1993
- ; write the information
- TOP N I,I1,J,K,X,ENPG
- N IOINLOW,IOINHI,IOINORM D ZIS^ENUTL
- S X="ENZWO1" X ^%ZOSF("TEST") I $T D ^ENZWO1
- S ENX("WP")=$S($L(EN(31))>120:3,$L(EN(31))>70:2,EN(31)]"":1,1:0),ENPG=0
- S ENX("AT")=0,I=100 F S I=$O(EN(I)) Q:'I S ENX("AT")=ENX("AT")+1
- S ENORIG=$P(^ENG(6920,DA,0),U,6) S ENORIG("P")=0 I ENORIG]"",ENORIG'=ENWO S ENORIG("P")=1
- S $X=1,$Y=0 W ?$S(ENORIG("P"):10,1:21) D W("WORK ORDER # "_ENWO)
- W:ENORIG("P") " (Original #: "_ENORIG_")"
- W ! D W(" 1) ") W "PRIMARY EMPL: " I EN(1)]"",$D(^ENG("EMP",EN(1),0)) D W($P(^(0),U))
- W ?39 D W(" 2) ") W "REQ DATE: " S X=EN(2) D PDT
- W ! D W(" 3) ") W "REQ MODE: " D W(EN(3)) W ?39 D W(" 4) ") W "LOCATION: " D:EN(4)]"" W(EN(4))
- W ! D W(" 5) ") W "BED #: " D:EN(5)]"" W(EN(5))
- W ?39 D W(" 6) ") W $S(ENDSTAT=35.2:"PM STATUS: ",1:"STATUS: ") D W($E(EN(6),1,18))
- W ! D W(" 7) ") W "TASK DESC: " D W(EN(7))
- TOP4 D TOP4^ENWOD3
- TOP15 W ! D W("25) ") W "WORK CTR: " D:EN(25)]"" W(EN(25))
- W ! D W("26) ") W "TOTAL HOURS: " D:EN(26)]"" W(EN(26))
- W ?39 D W("27) ") W "TOTAL MATERIAL COST: " D:EN(27)]"" W(EN(27))
- W ! D W("28) ") W "TOTAL LABOR COST: " D:EN(28)]"" W(EN(28))
- W ?39 D W("29) ") W "VENDOR SERVICE COST: " D:EN(29)]"" W(EN(29))
- W ! D W("30) ") W "*ASSIGNED TECH*" W ?39 D W("31) ") W "DATE COMPLETE: " S X=EN(31) D PDT
- I 'ENX("AT") G WP
- F I=101:1:(ENJ-1) D WRTEC I I=105,$D(EN(106)) D G:ENX="^" KILL
- . S ENX="" I $E(IOST,1,2)="C-" D HOLD W ! D W("30) ") W "*ASSIGNED TECH*"
- ;
- WP I 'ENPG,((ENX("AT")+ENX("WP"))>5),($E(IOST,1,2)="C-") D HOLD Q:ENX="^"
- W ! D W("32) ") W "WORK PERFORMED: "
- I EN(32)]"" D
- . I $L(EN(32))<60 D W(EN(32)) Q
- . K ^UTILITY($J,"W") S X=EN(32),DIWL=1,DIWR=59,DIWF="" D ^DIWP
- . S J=0 F S J=$O(^UTILITY($J,"W",1,J)) Q:'J W:J>1 !,?20 D W(^(J,0))
- I $D(^ENG(6920,DA,6)),'ENPG,$E(IOST,1,2)="C-" D HOLD G:ENX="^" KILL
- W ! D W("33) ") W "COMMENTS: "
- WCO S (ENX,X)="" I $D(^ENG(6920,DA,6)) S DIWL=5,DIWR=(IOM-5),DIWF="|" K ^UTILITY($J,"W") D G:ENX="^" KILL
- . S ENNX=0 F S ENNX=$O(^ENG(6920,DA,6,ENNX)) Q:'ENNX S X=^(ENNX,0) D ^DIWP
- . W IOINHI S ENNX=0 F S ENNX=$O(^UTILITY($J,"W",DIWL,ENNX)) Q:'ENNX W !,?DIWL,^UTILITY($J,"W",DIWL,ENNX,0) I (IOSL-$Y)'>2 D Q:ENX="^"
- .. W IOINLOW D HOLD
- .. W:ENX'="^" IOINHI
- . W IOINLOW
- I EN(14)]"",$D(^ENG(6914,EN(14),0)) K ENX S EQDA=EN(14) D NOTES(EQDA) D ; Look for flags
- . I $G(ENX("T"))>0 D
- .. I (IOSL-$Y)'>4 D HOLD Q:ENX="^"
- .. I ENX(1)]"" D
- ... W !,"WARRANTY EXPIRATION: ",IOINHI W:ENX(1)>DT "**" W $E(ENX(1),4,5),"/",$E(ENX(1),6,7),"/",$E(ENX(1),2,3) W:ENX(1)>DT "**" W IOINLOW
- ... I ENX(9)]"" W ?49 D W("JCAHO=YES")
- ... I ENX(4)]"" W !,"Last PMI was DEFERRED."
- .. I ENX(1)="",(ENX(4)]""!(ENX(9)]"")) D
- ... W ! W:ENX(4)]"" "Last PMI was DEFERRED." I ENX(9)]"" W ?49 D W("JCAHO=YES")
- .. I ENX(3) W ! D W("NOTE: Equipment must be isolated and rendered inoperative prior to service.")
- .. I ENX(7)]"" W !,"EQUIPMENT USE STATUS LISTED AS " D W(ENX(7)) W "."
- . I $D(ENX("WO")) D
- .. I (IOSL-$Y)'>5 D HOLD Q:ENX="^"
- .. W !!," [OTHER OPEN WORK ORDERS FOR THIS EQUIPMENT]"
- .. W !," Work Order #",?18,"Task Description"
- .. S SHOP=0 I $D(ENX("WO","HAZ")) D
- ... F S SHOP=$O(ENX("WO","HAZ",SHOP)) Q:SHOP'>0 S J=9999999999 D
- .... F S J=$O(ENX("WO","HAZ",SHOP,J),-1) Q:J'>0 W !,?2 D W($P(^ENG(6920,J,0),U)) W ?18 D W($E($P($G(^ENG(6920,J,1)),U,2),1,52)_" (Hazard)")
- .. S SHOP=0 I $D(ENX("WO","PM")) D
- ... F S SHOP=$O(ENX("WO","PM",SHOP)) Q:SHOP'>0 S J=$O(ENX("WO","PM",SHOP,0)) W !,?2,$P(^ENG(6920,J,0),U),?18,$P($G(^ENG(6920,J,5)),U,7)
- .. S J=9999999999,K=0
- .. F S J=$O(ENX("WO",J),-1),K=K+1 Q:J'>0!(K>9) W !,?2,$P(^ENG(6920,J,0),U),?18,$S($E(^(0),1,3)'="PM-":$P($G(^(1)),U,2),1:$P($G(^(5)),U,7)) I (IOSL-$Y)'>2 D HOLD Q:ENX="^"
- .. I K>9 W !,?2,"There are more..."
- S X="ENZWO2" X ^%ZOSF("TEST") I $T D ^ENZWO2
- I $O(^DIPT("B","ENZWO.LOCAL",0))>0 D
- . S L=0,DIC="^ENG(6920,",FLDS="[ENZWO.LOCAL]",BY=".01",(FR,TO)=ENWO,DHD="@@",IOP=ION,DISUPNO=1,ENX("DA")=DA
- . I (IOSL-$Y)'>5 D HOLD Q:ENX="^"
- . D EN1^DIP
- . S DA=ENX("DA")
- KILL K EN,ENLTH,ENORD,ENNU,ENNX,DIWL,DIWR,DIWF,ENA,ENB,ENTNX,ENORIG,ENJ,ENDATA,EQDA,ENX
- Q
- ;
- PDT ;Display date in external format
- I X]"" S Y=X X ^DD("DD") D W(Y)
- Q
- ;
- WRTEC ;Print assigned techs
- W !," #",I-100,": " I EN(I)]"",$D(^ENG("EMP",EN(I),0)) D W($P(^(0),U)) W " HRS: " D W(EN(I,1)) W " SHOP: " D W(EN(I,2))
- Q
- ;
- HOLD S ENX="" S:$G(ENPG)]"" ENPG=ENPG+1 I $E(IOST,1,2)="C-" D Q
- . W !,"Press <RETURN> to continue, '^' to escape..."
- . R ENX:DTIME
- . S $Y=0
- W @IOF,"(Work Order: "_ENWO_")"
- Q
- ;
- NOTES(EQDA) ; Check for flagging situations, counted in loc var ENX("T")
- ; EQDA contains IEN for file 6914
- ; Expects ENWO as IEN of work order in question
- ; Flagging situations noted in loc array ENX
- ;
- N HAZCODE,SHOP
- S HAZCODE=$O(^ENG(6920.1,"B","HAZARD ALERT (Equipment)",0))
- S I1=1,ENX("T")=0 F I=1:1:9 S ENX(I)=""
- S ENX(1)=$P($G(^ENG(6914,EQDA,2)),U,5) ;Warranty expiration
- S ENX(2)=$$GET1^DIQ(6914,EQDA,53) ;Condition code
- S ENX(3)=$P(^ENG(6914,EQDA,0),U,5) ;Lockout/Tagout
- S I=0 F S I=$O(^ENG(6914,EQDA,6,I)) Q:'I I $E($P(^(I,0),U,2),1,3)="PM-" Q:$P(^(0),U,3)'["D" S ENX(4)=$P(^(0),U,3) Q ;Deferred PM work order
- I $D(ENWO),$E(ENWO,1,3)'="PM-" D
- . S I=0,J=999999999999 F Q:I>30 S J=$O(^ENG(6920,"G",EQDA,J),-1) Q:J'>0 S I=I+1 D:$P($G(^ENG(6920,J,5)),U,2)=""
- .. I '$D(^ENG(6920,J,0)) K ^ENG(6920,"G",EQDA,J) Q
- .. I ENWO=$P(^ENG(6920,J,0),U) Q
- .. S K=0,SHOP=$P($G(^ENG(6920,J,2)),U) Q:SHOP'>0 I $E(^ENG(6920,J,0),1,3)="PM-",'$D(ENX("WO","PM",SHOP)) S ENX("WO","PM",SHOP,J)="" Q ;Open PM
- .. F S K=$O(^ENG(6920,J,8,K)) Q:K'>0 I ^(K,0)=HAZCODE S ENX("WO","HAZ",SHOP,J)="" Q ;Open Hazard Alert
- .. S:'$D(ENX("WO","HAZ",SHOP,J)) ENX("WO",J)=""
- S ENX(7)=$$GET1^DIQ(6914,EQDA,20) I ENX(7)]"","TURNED IN^LOST OR STOLEN"'[ENX(7) S ENX(7)=""
- S ENX(9)=$$GET1^DIQ(6914,EQDA,27) I ENX(9)'="YES" S ENX(9)="" ;jcaho
- S ENX("T")=(ENX(1)]"")+(ENX(4)]"")+(ENX(9)]"") I ENX("T")>1 S ENX("T")=ENX("T")-1
- S ENX("T")=ENX("T")+(ENX(3)]"")+(ENX(7)]"")
- 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
- ;ENWOD2
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENWOD2 6345 printed Jan 18, 2025@02:57:27 Page 2
- ENWOD2 ;(WASH ISC)/DLM/DH-Formatted Work Order Display ;12.10.97
- +1 ;;7.0;ENGINEERING;**15,35,42,43,47**;Aug 17, 1993
- +2 ; write the information
- TOP NEW I,I1,J,K,X,ENPG
- +1 NEW IOINLOW,IOINHI,IOINORM
- DO ZIS^ENUTL
- +2 SET X="ENZWO1"
- XECUTE ^%ZOSF("TEST")
- IF $TEST
- DO ^ENZWO1
- +3 SET ENX("WP")=$SELECT($LENGTH(EN(31))>120:3,$LENGTH(EN(31))>70:2,EN(31)]"":1,1:0)
- SET ENPG=0
- +4 SET ENX("AT")=0
- SET I=100
- FOR
- SET I=$ORDER(EN(I))
- if 'I
- QUIT
- SET ENX("AT")=ENX("AT")+1
- +5 SET ENORIG=$PIECE(^ENG(6920,DA,0),U,6)
- SET ENORIG("P")=0
- IF ENORIG]""
- IF ENORIG'=ENWO
- SET ENORIG("P")=1
- +6 SET $X=1
- SET $Y=0
- WRITE ?$SELECT(ENORIG("P"):10,1:21)
- DO W("WORK ORDER # "_ENWO)
- +7 if ENORIG("P")
- WRITE " (Original #: "_ENORIG_")"
- +8 WRITE !
- DO W(" 1) ")
- WRITE "PRIMARY EMPL: "
- IF EN(1)]""
- IF $DATA(^ENG("EMP",EN(1),0))
- DO W($PIECE(^(0),U))
- +9 WRITE ?39
- DO W(" 2) ")
- WRITE "REQ DATE: "
- SET X=EN(2)
- DO PDT
- +10 WRITE !
- DO W(" 3) ")
- WRITE "REQ MODE: "
- DO W(EN(3))
- WRITE ?39
- DO W(" 4) ")
- WRITE "LOCATION: "
- if EN(4)]""
- DO W(EN(4))
- +11 WRITE !
- DO W(" 5) ")
- WRITE "BED #: "
- if EN(5)]""
- DO W(EN(5))
- +12 WRITE ?39
- DO W(" 6) ")
- WRITE $SELECT(ENDSTAT=35.2:"PM STATUS: ",1:"STATUS: ")
- DO W($EXTRACT(EN(6),1,18))
- +13 WRITE !
- DO W(" 7) ")
- WRITE "TASK DESC: "
- DO W(EN(7))
- TOP4 DO TOP4^ENWOD3
- TOP15 WRITE !
- DO W("25) ")
- WRITE "WORK CTR: "
- if EN(25)]""
- DO W(EN(25))
- +1 WRITE !
- DO W("26) ")
- WRITE "TOTAL HOURS: "
- if EN(26)]""
- DO W(EN(26))
- +2 WRITE ?39
- DO W("27) ")
- WRITE "TOTAL MATERIAL COST: "
- if EN(27)]""
- DO W(EN(27))
- +3 WRITE !
- DO W("28) ")
- WRITE "TOTAL LABOR COST: "
- if EN(28)]""
- DO W(EN(28))
- +4 WRITE ?39
- DO W("29) ")
- WRITE "VENDOR SERVICE COST: "
- if EN(29)]""
- DO W(EN(29))
- +5 WRITE !
- DO W("30) ")
- WRITE "*ASSIGNED TECH*"
- WRITE ?39
- DO W("31) ")
- WRITE "DATE COMPLETE: "
- SET X=EN(31)
- DO PDT
- +6 IF 'ENX("AT")
- GOTO WP
- +7 FOR I=101:1:(ENJ-1)
- DO WRTEC
- IF I=105
- IF $DATA(EN(106))
- Begin DoDot:1
- +8 SET ENX=""
- IF $EXTRACT(IOST,1,2)="C-"
- DO HOLD
- WRITE !
- DO W("30) ")
- WRITE "*ASSIGNED TECH*"
- End DoDot:1
- if ENX="^"
- GOTO KILL
- +9 ;
- WP IF 'ENPG
- IF ((ENX("AT")+ENX("WP"))>5)
- IF ($EXTRACT(IOST,1,2)="C-")
- DO HOLD
- if ENX="^"
- QUIT
- +1 WRITE !
- DO W("32) ")
- WRITE "WORK PERFORMED: "
- +2 IF EN(32)]""
- Begin DoDot:1
- +3 IF $LENGTH(EN(32))<60
- DO W(EN(32))
- QUIT
- +4 KILL ^UTILITY($JOB,"W")
- SET X=EN(32)
- SET DIWL=1
- SET DIWR=59
- SET DIWF=""
- DO ^DIWP
- +5 SET J=0
- FOR
- SET J=$ORDER(^UTILITY($JOB,"W",1,J))
- if 'J
- QUIT
- if J>1
- WRITE !,?20
- DO W(^(J,0))
- End DoDot:1
- +6 IF $DATA(^ENG(6920,DA,6))
- IF 'ENPG
- IF $EXTRACT(IOST,1,2)="C-"
- DO HOLD
- if ENX="^"
- GOTO KILL
- +7 WRITE !
- DO W("33) ")
- WRITE "COMMENTS: "
- WCO SET (ENX,X)=""
- IF $DATA(^ENG(6920,DA,6))
- SET DIWL=5
- SET DIWR=(IOM-5)
- SET DIWF="|"
- KILL ^UTILITY($JOB,"W")
- Begin DoDot:1
- +1 SET ENNX=0
- FOR
- SET ENNX=$ORDER(^ENG(6920,DA,6,ENNX))
- if 'ENNX
- QUIT
- SET X=^(ENNX,0)
- DO ^DIWP
- +2 WRITE IOINHI
- SET ENNX=0
- FOR
- SET ENNX=$ORDER(^UTILITY($JOB,"W",DIWL,ENNX))
- if 'ENNX
- QUIT
- WRITE !,?DIWL,^UTILITY($JOB,"W",DIWL,ENNX,0)
- IF (IOSL-$Y)'>2
- Begin DoDot:2
- +3 WRITE IOINLOW
- DO HOLD
- +4 if ENX'="^"
- WRITE IOINHI
- End DoDot:2
- if ENX="^"
- QUIT
- +5 WRITE IOINLOW
- End DoDot:1
- if ENX="^"
- GOTO KILL
- +6 ; Look for flags
- IF EN(14)]""
- IF $DATA(^ENG(6914,EN(14),0))
- KILL ENX
- SET EQDA=EN(14)
- DO NOTES(EQDA)
- Begin DoDot:1
- +7 IF $GET(ENX("T"))>0
- Begin DoDot:2
- +8 IF (IOSL-$Y)'>4
- DO HOLD
- if ENX="^"
- QUIT
- +9 IF ENX(1)]""
- Begin DoDot:3
- +10 WRITE !,"WARRANTY EXPIRATION: ",IOINHI
- if ENX(1)>DT
- WRITE "**"
- WRITE $EXTRACT(ENX(1),4,5),"/",$EXTRACT(ENX(1),6,7),"/",$EXTRACT(ENX(1),2,3)
- if ENX(1)>DT
- WRITE "**"
- WRITE IOINLOW
- +11 IF ENX(9)]""
- WRITE ?49
- DO W("JCAHO=YES")
- +12 IF ENX(4)]""
- WRITE !,"Last PMI was DEFERRED."
- End DoDot:3
- +13 IF ENX(1)=""
- IF (ENX(4)]""!(ENX(9)]""))
- Begin DoDot:3
- +14 WRITE !
- if ENX(4)]""
- WRITE "Last PMI was DEFERRED."
- IF ENX(9)]""
- WRITE ?49
- DO W("JCAHO=YES")
- End DoDot:3
- +15 IF ENX(3)
- WRITE !
- DO W("NOTE: Equipment must be isolated and rendered inoperative prior to service.")
- +16 IF ENX(7)]""
- WRITE !,"EQUIPMENT USE STATUS LISTED AS "
- DO W(ENX(7))
- WRITE "."
- End DoDot:2
- +17 IF $DATA(ENX("WO"))
- Begin DoDot:2
- +18 IF (IOSL-$Y)'>5
- DO HOLD
- if ENX="^"
- QUIT
- +19 WRITE !!," [OTHER OPEN WORK ORDERS FOR THIS EQUIPMENT]"
- +20 WRITE !," Work Order #",?18,"Task Description"
- +21 SET SHOP=0
- IF $DATA(ENX("WO","HAZ"))
- Begin DoDot:3
- +22 FOR
- SET SHOP=$ORDER(ENX("WO","HAZ",SHOP))
- if SHOP'>0
- QUIT
- SET J=9999999999
- Begin DoDot:4
- +23 FOR
- SET J=$ORDER(ENX("WO","HAZ",SHOP,J),-1)
- if J'>0
- QUIT
- WRITE !,?2
- DO W($PIECE(^ENG(6920,J,0),U))
- WRITE ?18
- DO W($EXTRACT($PIECE($GET(^ENG(6920,J,1)),U,2),1,52)_" (Hazard)")
- End DoDot:4
- End DoDot:3
- +24 SET SHOP=0
- IF $DATA(ENX("WO","PM"))
- Begin DoDot:3
- +25 FOR
- SET SHOP=$ORDER(ENX("WO","PM",SHOP))
- if SHOP'>0
- QUIT
- SET J=$ORDER(ENX("WO","PM",SHOP,0))
- WRITE !,?2,$PIECE(^ENG(6920,J,0),U),?18,$PIECE($GET(^ENG(6920,J,5)),U,7)
- End DoDot:3
- +26 SET J=9999999999
- SET K=0
- +27 FOR
- SET J=$ORDER(ENX("WO",J),-1)
- SET K=K+1
- if J'>0!(K>9)
- QUIT
- WRITE !,?2,$PIECE(^ENG(6920,J,0),U),?18,$SELECT($EXTRACT(^(0),1,3)'="PM-":$PIECE($GET(^(1)),U,2),1:$PIECE($GET(^(5)),U,7))
- IF (IOSL-$Y)'>2
- DO HOLD
- if ENX="^"
- QUIT
- +28 IF K>9
- WRITE !,?2,"There are more..."
- End DoDot:2
- End DoDot:1
- +29 SET X="ENZWO2"
- XECUTE ^%ZOSF("TEST")
- IF $TEST
- DO ^ENZWO2
- +30 IF $ORDER(^DIPT("B","ENZWO.LOCAL",0))>0
- Begin DoDot:1
- +31 SET L=0
- SET DIC="^ENG(6920,"
- SET FLDS="[ENZWO.LOCAL]"
- SET BY=".01"
- SET (FR,TO)=ENWO
- SET DHD="@@"
- SET IOP=ION
- SET DISUPNO=1
- SET ENX("DA")=DA
- +32 IF (IOSL-$Y)'>5
- DO HOLD
- if ENX="^"
- QUIT
- +33 DO EN1^DIP
- +34 SET DA=ENX("DA")
- End DoDot:1
- KILL KILL EN,ENLTH,ENORD,ENNU,ENNX,DIWL,DIWR,DIWF,ENA,ENB,ENTNX,ENORIG,ENJ,ENDATA,EQDA,ENX
- +1 QUIT
- +2 ;
- PDT ;Display date in external format
- +1 IF X]""
- SET Y=X
- XECUTE ^DD("DD")
- DO W(Y)
- +2 QUIT
- +3 ;
- WRTEC ;Print assigned techs
- +1 WRITE !," #",I-100,": "
- IF EN(I)]""
- IF $DATA(^ENG("EMP",EN(I),0))
- DO W($PIECE(^(0),U))
- WRITE " HRS: "
- DO W(EN(I,1))
- WRITE " SHOP: "
- DO W(EN(I,2))
- +2 QUIT
- +3 ;
- HOLD SET ENX=""
- if $GET(ENPG)]""
- SET ENPG=ENPG+1
- IF $EXTRACT(IOST,1,2)="C-"
- Begin DoDot:1
- +1 WRITE !,"Press <RETURN> to continue, '^' to escape..."
- +2 READ ENX:DTIME
- +3 SET $Y=0
- End DoDot:1
- QUIT
- +4 WRITE @IOF,"(Work Order: "_ENWO_")"
- +5 QUIT
- +6 ;
- NOTES(EQDA) ; Check for flagging situations, counted in loc var ENX("T")
- +1 ; EQDA contains IEN for file 6914
- +2 ; Expects ENWO as IEN of work order in question
- +3 ; Flagging situations noted in loc array ENX
- +4 ;
- +5 NEW HAZCODE,SHOP
- +6 SET HAZCODE=$ORDER(^ENG(6920.1,"B","HAZARD ALERT (Equipment)",0))
- +7 SET I1=1
- SET ENX("T")=0
- FOR I=1:1:9
- SET ENX(I)=""
- +8 ;Warranty expiration
- SET ENX(1)=$PIECE($GET(^ENG(6914,EQDA,2)),U,5)
- +9 ;Condition code
- SET ENX(2)=$$GET1^DIQ(6914,EQDA,53)
- +10 ;Lockout/Tagout
- SET ENX(3)=$PIECE(^ENG(6914,EQDA,0),U,5)
- +11 ;Deferred PM work order
- SET I=0
- FOR
- SET I=$ORDER(^ENG(6914,EQDA,6,I))
- if 'I
- QUIT
- IF $EXTRACT($PIECE(^(I,0),U,2),1,3)="PM-"
- if $PIECE(^(0),U,3)'["D"
- QUIT
- SET ENX(4)=$PIECE(^(0),U,3)
- QUIT
- +12 IF $DATA(ENWO)
- IF $EXTRACT(ENWO,1,3)'="PM-"
- Begin DoDot:1
- +13 SET I=0
- SET J=999999999999
- FOR
- if I>30
- QUIT
- SET J=$ORDER(^ENG(6920,"G",EQDA,J),-1)
- if J'>0
- QUIT
- SET I=I+1
- if $PIECE($GET(^ENG(6920,J,5)),U,2)=""
- Begin DoDot:2
- +14 IF '$DATA(^ENG(6920,J,0))
- KILL ^ENG(6920,"G",EQDA,J)
- QUIT
- +15 IF ENWO=$PIECE(^ENG(6920,J,0),U)
- QUIT
- +16 ;Open PM
- SET K=0
- SET SHOP=$PIECE($GET(^ENG(6920,J,2)),U)
- if SHOP'>0
- QUIT
- IF $EXTRACT(^ENG(6920,J,0),1,3)="PM-"
- IF '$DATA(ENX("WO","PM",SHOP))
- SET ENX("WO","PM",SHOP,J)=""
- QUIT
- +17 ;Open Hazard Alert
- FOR
- SET K=$ORDER(^ENG(6920,J,8,K))
- if K'>0
- QUIT
- IF ^(K,0)=HAZCODE
- SET ENX("WO","HAZ",SHOP,J)=""
- QUIT
- +18 if '$DATA(ENX("WO","HAZ",SHOP,J))
- SET ENX("WO",J)=""
- End DoDot:2
- End DoDot:1
- +19 SET ENX(7)=$$GET1^DIQ(6914,EQDA,20)
- IF ENX(7)]""
- IF "TURNED IN^LOST OR STOLEN"'[ENX(7)
- SET ENX(7)=""
- +20 ;jcaho
- SET ENX(9)=$$GET1^DIQ(6914,EQDA,27)
- IF ENX(9)'="YES"
- SET ENX(9)=""
- +21 SET ENX("T")=(ENX(1)]"")+(ENX(4)]"")+(ENX(9)]"")
- IF ENX("T")>1
- SET ENX("T")=ENX("T")-1
- +22 SET ENX("T")=ENX("T")+(ENX(3)]"")+(ENX(7)]"")
- +23 QUIT
- +24 ;
- 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 ;ENWOD2