- ENY2KR1 ;(WASH ISC)/DH-Rapid Y2K Close Out ;6.16.98
- ;;7.0;ENGINEERING;**51**;Aug 17, 1993
- CAT ; rapid closeout by equipment category
- N CAT,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE,DATE,COST,Y2DA,SORT,WO,CRITER
- S CRITER="SKIP"
- D CAT1^ENY2K ; get a range of work orders (by equipment id)
- Q:'$G(ENY2K("CONT"))!('$D(^TMP($J)))
- S SORT=$E(CAT,1,20)
- D Y2KWO,PROCS
- G EXIT
- ;
- CSN ; rapid closeout by category stock number
- N CSN,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE,DATE,COST,Y2DA,SORT,WO,CRITER
- S CRITER="SKIP"
- D CSN1^ENY2K ; get a range of work orders (by equipment id)
- Q:'$G(ENY2K("CONT"))!('$D(^TMP($J)))
- S SORT=$E(CSN,1,20)
- D Y2KWO,PROCS
- G EXIT
- ;
- MEN ; rapid closeout by manufacturer equipment name (trade name)
- ; menu option disabled at request of TAG
- N MEN,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE,DATE,COST,Y2DA,SORT,WO,CRITER
- S CRITER="SKIP"
- D MEN1^ENY2KA ; get a range of work orders (by equipment id)
- Q:'$G(ENY2K("CONT"))!('$D(^TMP($J)))
- S SORT=$E(MEN,1,20)
- D Y2KWO,PROCS
- G EXIT
- ;
- MFG ; rapid closeout by manufacturer
- N MFG,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE,DATE,COST,Y2DA,SORT,WO,CRITER
- S CRITER="SKIP"
- D MFG1^ENY2K ; get a range of work orders (by equipment id)
- Q:'$G(ENY2K("CONT"))!('$D(^TMP($J)))
- S SORT=$E(MFG,1,20)
- D Y2KWO,PROCS
- G EXIT
- ;
- LOC ; rapid closeout by range of local identifiers
- N LOC,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE,DATE,COST,Y2DA,SORT,END,WO,CRITER
- S CRITER="SKIP"
- D LOC1^ENY2K9 ; get a range of work orders (by equipment id)
- Q:'$G(ENY2K("CONT"))!('$D(^TMP($J)))
- S SORT=$E(LOC,1,10)_"-"_$E(END,1,10)
- D Y2KWO,PROCS
- G EXIT
- ;
- MOD ; rapid closeout by manufacturer and model
- N MFG,MOD,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE,DATE,COST,Y2DA,SORT,WO,CRITER
- S CRITER="SKIP"
- D MOD1^ENY2K ; get a range of work orders (by equipment id)
- Q:'$G(ENY2K("CONT"))!('$D(^TMP($J)))
- S SORT=$E(MFG,1,12)_"/"_$E(MOD,1,12)
- D Y2KWO,PROCS
- G EXIT
- ;
- Y2KWO ; check for open Y2K work orders
- S DA=0,COUNT("Y2KWO")=0 F S DA=$O(^TMP($J,DA)) Q:'DA D
- . S WO=$P($G(^ENG(6914,DA,11)),U,8) Q:WO'>0
- . I $D(^ENG(6920,WO,0)),$P($G(^(5)),U,2)="" S ^TMP($J,"Y2KWO",DA)="",^TMP($J,"Y2KWO_LIST",$P(^ENG(6920,WO,0),U),DA)="",COUNT("Y2KWO")=COUNT("Y2KWO")+1
- Q
- ;
- PROCS ; close the Y2K work orders
- I '$D(^TMP($J,"Y2KWO")) W !!,"None of the selected equipment entries have open Y2K work orders.",!,"Data base unchanged." G EXIT
- W !!,COUNT("Y2KWO")_" of the selected equipment records have open Y2K work orders which",!,"may now be closed."
- W !!,"First we'll print a list of the open Y2K work orders."
- N PAGE
- D NOW^%DTC S Y=% X ^DD("DD") S DATE("PRNT")=$P(Y,":",1,2)
- W ! S %ZIS="" D ^%ZIS G:POP EXIT S PAGE=0
- U IO
- D HDR S (WO,DA)="" F S WO=$O(^TMP($J,"Y2KWO_LIST",WO)) Q:WO="" S DA=$O(^(WO,0)) D:DA>0 Q:$G(ESCAPE)
- . I (IOSL-$Y)'>2 D HOLD,HDR
- . W !,WO,?34,$J(DA,10)
- I IO=IO(0) D HOLD G:$G(ESCAPE) EXIT
- I IO'=IO(0) D ^%ZISC G:$G(ESCAPE) EXIT
- W @IOF,!,"Rapid Close Out of Y2K work orders will automatically place the affected",!,"equipment in a Y2K CATEGORY of 'FULLY COMPLIANT'."
- W !!,"It is assumed that you have reviewed the list of open Y2K work orders just",!,"printed. You will have an opportunity to remove individual work orders from"
- W !,"this closeout list by specifying their equipment entry numbers."
- W !!,"If any of these equipment entries have been erroneously classified as",!,"'CONDITIONALLY COMPLIANT', then you should remove them from the closeout list."
- W !!,"You should then use the 'Delete Y2K Work Orders' option [ENY2K_DEL] to delete",!,"the work orders instead of closing them. Finally, you should use the 'Manual"
- W !,"Equipment Selection for Y2K' option [ENY2KIND], which is under 'Y2K Data Entry'",!,"[ENY2K_ENTRY], to enter correct Y2K information for the subject equipment."
- W !!,"Please enter any equipment entry numbers that should be removed from the",!,"closeout list:"
- W ! S COUNT("Y2KWO","REMOVE")=0 F D GETEQ^ENUTL Q:Y'>0 D
- . I $D(^TMP($J,"Y2KWO",+Y)) K ^(+Y) S COUNT("Y2KWO","REMOVE")=COUNT("Y2KWO","REMOVE")+1
- I COUNT("Y2KWO","REMOVE")=COUNT("Y2KWO") W !!,"There's nothing left to close out. Data base unchanged." G EXIT
- W !!,COUNT("Y2KWO")-COUNT("Y2KWO","REMOVE")_" Y2K work orders are about to be closed out. Are you sure that",!,"you want to proceed?"
- S DIR(0)="Y",DIR("B")="YES"
- D ^DIR K DIR I $D(DIRUT)!('Y) G EXIT
- ;
- PROCD D FIRST Q:$G(ESCAPE) ; EQDA now set to first ^TMP($J,"Y2KWO" node
- S COUNT=1,COUNT("LOCK")=0 F S EQDA=$O(^TMP($J,"Y2KWO",EQDA)) Q:'EQDA D SUBSQNT
- W !,COUNT_" Y2K work orders were closed."
- I COUNT("LOCK") D
- . W !,"Work orders for the following "_COUNT("LOCK")_" equipment records could not be",!,"locked and were, therefore, not processed:"
- . S EQDA=0 F S EQDA=$O(^TMP($J,"LOCK",EQDA)) Q:'EQDA D Q:$G(ESCAPE)
- .. I (IOSL-$Y)'>2 D HOLD Q:$G(ESCAPE) W @IOF
- .. W !,?10,EQDA
- Q
- ;
- FIRST ; close out first Y2K work order
- S EQDA=$O(^TMP($J,"Y2KWO",0)),DA=$P(^ENG(6914,EQDA,11),U,8) I DA>0,'$D(^ENG(6920,DA,0)) S DA=""
- I DA'>0 F S EQDA=$O(^TMP($J,"Y2KWO",EQDA)) Q:'EQDA S DA=$P(^ENG(6914,EQDA,11),U,8) I DA>0,$D(^ENG(6920,DA,0)) D Q:DA>0
- . I $P($G(^ENG(6920,DA,5)),U,2)]"" S DA="" Q ; completed work order
- . L +^ENG(6920,DA):1 I '$T S ^TMP($J,"LOCK",EQDA)="",COUNT("LOCK")=COUNT("LOCK")+1 S DA=""
- I DA'>0 W !!,"There are no open Y2K work orders that can be closed. Data base unchanged." S ESCAPE=1 Q ;nothing to do
- W !!,"You will be prompted to close the first Y2K work order manually, after which",!,"the system will take care of the others automatically."
- W !!,"EQUIPMENT ID#: "_EQDA_" "_SORT_" "_$E($$GET1^DIQ(6914,EQDA,1),1,20)_" "_$E($$GET1^DIQ(6914,EQDA,4),1,20)
- S Y2DA=DA
- S DIE="^ENG(6920,",DR=$S($D(^DIE("B","ENZY2CLOSE")):"[ENZY2CLOSE]",1:"[ENY2CLOSE]")
- D ^DIE I $P($G(^ENG(6920,DA,5)),U,2)="" W !,"The work order was not closed out. Terminating the option." D HOLD L -^ENG(6920,DA) S ESCAPE=1 Q
- S X=$G(^ENG(6920,DA,5)),ENY2K("WORK")=$P(X,U,7),ENY2K("HOURS")=$P(X,U,3)
- S ENY2K("PRIM")=$P($G(^ENG(6920,DA,2)),U,2)
- S DATE=$P(^ENG(6920,DA,5),U,2),COST("L")=$P(^(5),U,6),COST("M")=$P(^(5),U,4),COST("V")=$P($G(^(4)),U,4)
- S Y=DATE D DD^%DT S DATE("E")=Y
- S COST=COST("L")+COST("M")+COST("V")
- S DA=EQDA,DIE="^ENG(6914,",DR="71///^S X=""FC"";72.1///^S X=DATE;74///^S X=COST" D ^DIE
- Q
- ;
- SUBSQNT ; finish the list
- S DA=$P(^ENG(6914,EQDA,11),U,8) Q:DA'>0 Q:'$D(^ENG(6920,DA,0))
- Q:$P($G(^ENG(6920,DA,5)),U,2)]"" ; completed work order
- L +^ENG(6920,DA):1 I '$T S ^TMP($J,"LOCK",EQDA)="" Q
- S ENY2WO=$P(^ENG(6920,DA,0),U),COUNT=COUNT+1
- S DIE="^ENG(6920,",%X="^ENG(6920,"_Y2DA_",7,",%Y="^ENG(6920,"_DA_",7," D %XY^%RCR ;assigned techs
- S %X="^ENG(6920,"_Y2DA_",8,",%Y="^ENG(6920,"_DA_",8," D %XY^%RCR ;work actions
- S DR="39///^S X=ENY2K(""WORK"");16///^S X=ENY2K(""PRIM"");37.5///^S X=COST(""L"");38///^S X=COST(""M"");47///^S X=COST(""V"");37///^S X=ENY2K(""HOURS"");36///^S X=DATE(""E"");32///^S X=""COMPLETED"""
- D ^DIE
- S DIE="^ENG(6914,",DA=EQDA,DR="71///^S X=""FC"";72.1///^S X=DATE(""E"");74///^S X=COST"
- D ^DIE
- Q
- ;
- HDR ; header for Y2K work order list
- W:PAGE>0!($E(IOST,1,2)="C-") @IOF S PAGE=PAGE+1
- W "Y2K Work Orders Now Subject to Rapid Closeout "_DATE("PRNT")_" Page: "_PAGE
- W !,"Work Order Number",?25,"Equipment Entry Number"
- K X S $P(X,"-",79)="-" W !,X
- Q
- ;
- HOLD I $E(IOST,1,2)="C-" R !,"<cr> to continue, '^' to quit...",X:DTIME S:X="^" ESCAPE=1
- Q
- ;
- EXIT K ^TMP($J)
- K ENY2WO,EQDA
- Q
- ;ENY2KR1
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENY2KR1 7510 printed Mar 13, 2025@21:02:03 Page 2
- ENY2KR1 ;(WASH ISC)/DH-Rapid Y2K Close Out ;6.16.98
- +1 ;;7.0;ENGINEERING;**51**;Aug 17, 1993
- CAT ; rapid closeout by equipment category
- +1 NEW CAT,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE,DATE,COST,Y2DA,SORT,WO,CRITER
- +2 SET CRITER="SKIP"
- +3 ; get a range of work orders (by equipment id)
- DO CAT1^ENY2K
- +4 if '$GET(ENY2K("CONT"))!('$DATA(^TMP($JOB)))
- QUIT
- +5 SET SORT=$EXTRACT(CAT,1,20)
- +6 DO Y2KWO
- DO PROCS
- +7 GOTO EXIT
- +8 ;
- CSN ; rapid closeout by category stock number
- +1 NEW CSN,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE,DATE,COST,Y2DA,SORT,WO,CRITER
- +2 SET CRITER="SKIP"
- +3 ; get a range of work orders (by equipment id)
- DO CSN1^ENY2K
- +4 if '$GET(ENY2K("CONT"))!('$DATA(^TMP($JOB)))
- QUIT
- +5 SET SORT=$EXTRACT(CSN,1,20)
- +6 DO Y2KWO
- DO PROCS
- +7 GOTO EXIT
- +8 ;
- MEN ; rapid closeout by manufacturer equipment name (trade name)
- +1 ; menu option disabled at request of TAG
- +2 NEW MEN,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE,DATE,COST,Y2DA,SORT,WO,CRITER
- +3 SET CRITER="SKIP"
- +4 ; get a range of work orders (by equipment id)
- DO MEN1^ENY2KA
- +5 if '$GET(ENY2K("CONT"))!('$DATA(^TMP($JOB)))
- QUIT
- +6 SET SORT=$EXTRACT(MEN,1,20)
- +7 DO Y2KWO
- DO PROCS
- +8 GOTO EXIT
- +9 ;
- MFG ; rapid closeout by manufacturer
- +1 NEW MFG,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE,DATE,COST,Y2DA,SORT,WO,CRITER
- +2 SET CRITER="SKIP"
- +3 ; get a range of work orders (by equipment id)
- DO MFG1^ENY2K
- +4 if '$GET(ENY2K("CONT"))!('$DATA(^TMP($JOB)))
- QUIT
- +5 SET SORT=$EXTRACT(MFG,1,20)
- +6 DO Y2KWO
- DO PROCS
- +7 GOTO EXIT
- +8 ;
- LOC ; rapid closeout by range of local identifiers
- +1 NEW LOC,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE,DATE,COST,Y2DA,SORT,END,WO,CRITER
- +2 SET CRITER="SKIP"
- +3 ; get a range of work orders (by equipment id)
- DO LOC1^ENY2K9
- +4 if '$GET(ENY2K("CONT"))!('$DATA(^TMP($JOB)))
- QUIT
- +5 SET SORT=$EXTRACT(LOC,1,10)_"-"_$EXTRACT(END,1,10)
- +6 DO Y2KWO
- DO PROCS
- +7 GOTO EXIT
- +8 ;
- MOD ; rapid closeout by manufacturer and model
- +1 NEW MFG,MOD,DIC,DIE,DA,DR,COUNT,ENY2K,ESCAPE,DATE,COST,Y2DA,SORT,WO,CRITER
- +2 SET CRITER="SKIP"
- +3 ; get a range of work orders (by equipment id)
- DO MOD1^ENY2K
- +4 if '$GET(ENY2K("CONT"))!('$DATA(^TMP($JOB)))
- QUIT
- +5 SET SORT=$EXTRACT(MFG,1,12)_"/"_$EXTRACT(MOD,1,12)
- +6 DO Y2KWO
- DO PROCS
- +7 GOTO EXIT
- +8 ;
- Y2KWO ; check for open Y2K work orders
- +1 SET DA=0
- SET COUNT("Y2KWO")=0
- FOR
- SET DA=$ORDER(^TMP($JOB,DA))
- if 'DA
- QUIT
- Begin DoDot:1
- +2 SET WO=$PIECE($GET(^ENG(6914,DA,11)),U,8)
- if WO'>0
- QUIT
- +3 IF $DATA(^ENG(6920,WO,0))
- IF $PIECE($GET(^(5)),U,2)=""
- SET ^TMP($JOB,"Y2KWO",DA)=""
- SET ^TMP($JOB,"Y2KWO_LIST",$PIECE(^ENG(6920,WO,0),U),DA)=""
- SET COUNT("Y2KWO")=COUNT("Y2KWO")+1
- End DoDot:1
- +4 QUIT
- +5 ;
- PROCS ; close the Y2K work orders
- +1 IF '$DATA(^TMP($JOB,"Y2KWO"))
- WRITE !!,"None of the selected equipment entries have open Y2K work orders.",!,"Data base unchanged."
- GOTO EXIT
- +2 WRITE !!,COUNT("Y2KWO")_" of the selected equipment records have open Y2K work orders which",!,"may now be closed."
- +3 WRITE !!,"First we'll print a list of the open Y2K work orders."
- +4 NEW PAGE
- +5 DO NOW^%DTC
- SET Y=%
- XECUTE ^DD("DD")
- SET DATE("PRNT")=$PIECE(Y,":",1,2)
- +6 WRITE !
- SET %ZIS=""
- DO ^%ZIS
- if POP
- GOTO EXIT
- SET PAGE=0
- +7 USE IO
- +8 DO HDR
- SET (WO,DA)=""
- FOR
- SET WO=$ORDER(^TMP($JOB,"Y2KWO_LIST",WO))
- if WO=""
- QUIT
- SET DA=$ORDER(^(WO,0))
- if DA>0
- Begin DoDot:1
- +9 IF (IOSL-$Y)'>2
- DO HOLD
- DO HDR
- +10 WRITE !,WO,?34,$JUSTIFY(DA,10)
- End DoDot:1
- if $GET(ESCAPE)
- QUIT
- +11 IF IO=IO(0)
- DO HOLD
- if $GET(ESCAPE)
- GOTO EXIT
- +12 IF IO'=IO(0)
- DO ^%ZISC
- if $GET(ESCAPE)
- GOTO EXIT
- +13 WRITE @IOF,!,"Rapid Close Out of Y2K work orders will automatically place the affected",!,"equipment in a Y2K CATEGORY of 'FULLY COMPLIANT'."
- +14 WRITE !!,"It is assumed that you have reviewed the list of open Y2K work orders just",!,"printed. You will have an opportunity to remove individual work orders from"
- +15 WRITE !,"this closeout list by specifying their equipment entry numbers."
- +16 WRITE !!,"If any of these equipment entries have been erroneously classified as",!,"'CONDITIONALLY COMPLIANT', then you should remove them from the closeout list."
- +17 WRITE !!,"You should then use the 'Delete Y2K Work Orders' option [ENY2K_DEL] to delete",!,"the work orders instead of closing them. Finally, you should use the 'Manual"
- +18 WRITE !,"Equipment Selection for Y2K' option [ENY2KIND], which is under 'Y2K Data Entry'",!,"[ENY2K_ENTRY], to enter correct Y2K information for the subject equipment."
- +19 WRITE !!,"Please enter any equipment entry numbers that should be removed from the",!,"closeout list:"
- +20 WRITE !
- SET COUNT("Y2KWO","REMOVE")=0
- FOR
- DO GETEQ^ENUTL
- if Y'>0
- QUIT
- Begin DoDot:1
- +21 IF $DATA(^TMP($JOB,"Y2KWO",+Y))
- KILL ^(+Y)
- SET COUNT("Y2KWO","REMOVE")=COUNT("Y2KWO","REMOVE")+1
- End DoDot:1
- +22 IF COUNT("Y2KWO","REMOVE")=COUNT("Y2KWO")
- WRITE !!,"There's nothing left to close out. Data base unchanged."
- GOTO EXIT
- +23 WRITE !!,COUNT("Y2KWO")-COUNT("Y2KWO","REMOVE")_" Y2K work orders are about to be closed out. Are you sure that",!,"you want to proceed?"
- +24 SET DIR(0)="Y"
- SET DIR("B")="YES"
- +25 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)!('Y)
- GOTO EXIT
- +26 ;
- PROCD ; EQDA now set to first ^TMP($J,"Y2KWO" node
- DO FIRST
- if $GET(ESCAPE)
- QUIT
- +1 SET COUNT=1
- SET COUNT("LOCK")=0
- FOR
- SET EQDA=$ORDER(^TMP($JOB,"Y2KWO",EQDA))
- if 'EQDA
- QUIT
- DO SUBSQNT
- +2 WRITE !,COUNT_" Y2K work orders were closed."
- +3 IF COUNT("LOCK")
- Begin DoDot:1
- +4 WRITE !,"Work orders for the following "_COUNT("LOCK")_" equipment records could not be",!,"locked and were, therefore, not processed:"
- +5 SET EQDA=0
- FOR
- SET EQDA=$ORDER(^TMP($JOB,"LOCK",EQDA))
- if 'EQDA
- QUIT
- Begin DoDot:2
- +6 IF (IOSL-$Y)'>2
- DO HOLD
- if $GET(ESCAPE)
- QUIT
- WRITE @IOF
- +7 WRITE !,?10,EQDA
- End DoDot:2
- if $GET(ESCAPE)
- QUIT
- End DoDot:1
- +8 QUIT
- +9 ;
- FIRST ; close out first Y2K work order
- +1 SET EQDA=$ORDER(^TMP($JOB,"Y2KWO",0))
- SET DA=$PIECE(^ENG(6914,EQDA,11),U,8)
- IF DA>0
- IF '$DATA(^ENG(6920,DA,0))
- SET DA=""
- +2 IF DA'>0
- FOR
- SET EQDA=$ORDER(^TMP($JOB,"Y2KWO",EQDA))
- if 'EQDA
- QUIT
- SET DA=$PIECE(^ENG(6914,EQDA,11),U,8)
- IF DA>0
- IF $DATA(^ENG(6920,DA,0))
- Begin DoDot:1
- +3 ; completed work order
- IF $PIECE($GET(^ENG(6920,DA,5)),U,2)]""
- SET DA=""
- QUIT
- +4 LOCK +^ENG(6920,DA):1
- IF '$TEST
- SET ^TMP($JOB,"LOCK",EQDA)=""
- SET COUNT("LOCK")=COUNT("LOCK")+1
- SET DA=""
- End DoDot:1
- if DA>0
- QUIT
- +5 ;nothing to do
- IF DA'>0
- WRITE !!,"There are no open Y2K work orders that can be closed. Data base unchanged."
- SET ESCAPE=1
- QUIT
- +6 WRITE !!,"You will be prompted to close the first Y2K work order manually, after which",!,"the system will take care of the others automatically."
- +7 WRITE !!,"EQUIPMENT ID#: "_EQDA_" "_SORT_" "_$EXTRACT($$GET1^DIQ(6914,EQDA,1),1,20)_" "_$EXTRACT($$GET1^DIQ(6914,EQDA,4),1,20)
- +8 SET Y2DA=DA
- +9 SET DIE="^ENG(6920,"
- SET DR=$SELECT($DATA(^DIE("B","ENZY2CLOSE")):"[ENZY2CLOSE]",1:"[ENY2CLOSE]")
- +10 DO ^DIE
- IF $PIECE($GET(^ENG(6920,DA,5)),U,2)=""
- WRITE !,"The work order was not closed out. Terminating the option."
- DO HOLD
- LOCK -^ENG(6920,DA)
- SET ESCAPE=1
- QUIT
- +11 SET X=$GET(^ENG(6920,DA,5))
- SET ENY2K("WORK")=$PIECE(X,U,7)
- SET ENY2K("HOURS")=$PIECE(X,U,3)
- +12 SET ENY2K("PRIM")=$PIECE($GET(^ENG(6920,DA,2)),U,2)
- +13 SET DATE=$PIECE(^ENG(6920,DA,5),U,2)
- SET COST("L")=$PIECE(^(5),U,6)
- SET COST("M")=$PIECE(^(5),U,4)
- SET COST("V")=$PIECE($GET(^(4)),U,4)
- +14 SET Y=DATE
- DO DD^%DT
- SET DATE("E")=Y
- +15 SET COST=COST("L")+COST("M")+COST("V")
- +16 SET DA=EQDA
- SET DIE="^ENG(6914,"
- SET DR="71///^S X=""FC"";72.1///^S X=DATE;74///^S X=COST"
- DO ^DIE
- +17 QUIT
- +18 ;
- SUBSQNT ; finish the list
- +1 SET DA=$PIECE(^ENG(6914,EQDA,11),U,8)
- if DA'>0
- QUIT
- if '$DATA(^ENG(6920,DA,0))
- QUIT
- +2 ; completed work order
- if $PIECE($GET(^ENG(6920,DA,5)),U,2)]""
- QUIT
- +3 LOCK +^ENG(6920,DA):1
- IF '$TEST
- SET ^TMP($JOB,"LOCK",EQDA)=""
- QUIT
- +4 SET ENY2WO=$PIECE(^ENG(6920,DA,0),U)
- SET COUNT=COUNT+1
- +5 ;assigned techs
- SET DIE="^ENG(6920,"
- SET %X="^ENG(6920,"_Y2DA_",7,"
- SET %Y="^ENG(6920,"_DA_",7,"
- DO %XY^%RCR
- +6 ;work actions
- SET %X="^ENG(6920,"_Y2DA_",8,"
- SET %Y="^ENG(6920,"_DA_",8,"
- DO %XY^%RCR
- +7 SET DR="39///^S X=ENY2K(""WORK"");16///^S X=ENY2K(""PRIM"");37.5///^S X=COST(""L"");38///^S X=COST(""M"");47///^S X=COST(""V"");37///^S X=ENY2K(""HOURS"");36///^S X=DATE(""E"");32///^S X=""COMPLETED"""
- +8 DO ^DIE
- +9 SET DIE="^ENG(6914,"
- SET DA=EQDA
- SET DR="71///^S X=""FC"";72.1///^S X=DATE(""E"");74///^S X=COST"
- +10 DO ^DIE
- +11 QUIT
- +12 ;
- HDR ; header for Y2K work order list
- +1 if PAGE>0!($EXTRACT(IOST,1,2)="C-")
- WRITE @IOF
- SET PAGE=PAGE+1
- +2 WRITE "Y2K Work Orders Now Subject to Rapid Closeout "_DATE("PRNT")_" Page: "_PAGE
- +3 WRITE !,"Work Order Number",?25,"Equipment Entry Number"
- +4 KILL X
- SET $PIECE(X,"-",79)="-"
- WRITE !,X
- +5 QUIT
- +6 ;
- HOLD IF $EXTRACT(IOST,1,2)="C-"
- READ !,"<cr> to continue, '^' to quit...",X:DTIME
- if X="^"
- SET ESCAPE=1
- +1 QUIT
- +2 ;
- EXIT KILL ^TMP($JOB)
- +1 KILL ENY2WO,EQDA
- +2 QUIT
- +3 ;ENY2KR1
