- ENY2K9 ;;(WIRMFO)/DH-Equipment Y2K Management ;5.8.98
- ;;7.0;ENGINEERING;**51**;August 17, 1993
- ; extension of ENY2K to handle local ids
- LOC1 K ^TMP($J)
- N STOP
- R !!,"Please enter the starting LOCAL ID: ",X:DTIME I '$T!($E(X)="^")!(X="") S ESCAPE=1 Q
- S LOC=X
- I '$D(^ENG(6914,"L",LOC)) D Q:$G(ESCAPE) G:LOC="" LOC1
- . S L=$L(LOC),LOC(1)=$O(^ENG(6914,"L",LOC))
- . I $E(LOC(1),1,L)=LOC S LOC=LOC(1) Q
- . S LOC="" W "??",*7
- . S DIR(0)="Y",DIR("A")="Would you like a list of valid LOCAL IDs",DIR("B")="YES"
- . D ^DIR K DIR Q:'Y
- . S %ZIS="" D ^%ZIS I POP S ESCAPE=1 Q
- . S PAGE=0,Y=DT D NOW^%DTC S Y=% X ^DD("DD") S DATE("PRNT")=$P(Y,":",1,2)
- . D LOCHDR S LOC(2)="" F S LOC(2)=$O(^ENG(6914,"L",LOC(2))) Q:LOC(2)="" W !,?5,$J(LOC(2),15) I (IOSL-$Y)'>2 D HOLD,LOCHDR Q:$G(STOP)
- W " ("_LOC_")"
- LOC2 W !,"Go thru (or '^' to escape): "_LOC_"// " R END:DTIME I '$T!($E(END)="^") S LOC="" G LOC1
- I LOC]END W !!,"The ending point may not preceed the starting point." S (LOC,END)="" G LOC1
- L +^ENG("LOC",LOC):1 I '$T W !,"Another user is editing this LOCAL ID. Can't proceed." S (LOC,END)="" G LOC1
- F J="PRE","FC","NC","CC","NA" S COUNT(J)=0
- S (DA,COUNT)=0,LOC(0)=LOC F S DA=$O(^ENG(6914,"L",LOC(0),DA)) Q:'DA D
- . I $D(^ENG(6914,DA,0)),"^4^5^"'[(U_$P($G(^(3)),U)_U) S COUNT=COUNT+1,^TMP($J,DA)="",X=$P($G(^ENG(6914,DA,11)),U) I X]"" S COUNT("PRE")=COUNT("PRE")+1,COUNT(X)=COUNT(X)+1,^TMP($J,X,DA)=""
- F S LOC(0)=$O(^ENG(6914,"L",LOC(0))) Q:LOC(0)]END!(LOC(0)="") S DA=0 F S DA=$O(^ENG(6914,"L",LOC(0),DA)) Q:'DA D
- . I $D(^ENG(6914,DA,0)),"^4^5^"'[(U_$P($G(^(3)),U)_U) S COUNT=COUNT+1,^TMP($J,DA)="",X=$P($G(^ENG(6914,DA,11)),U) I X]"" S COUNT("PRE")=COUNT("PRE")+1,COUNT(J)=COUNT(J)+1,^TMP($J,X,DA)=""
- I 'COUNT W !!,"There are no active equipment records within the selected range." L -^ENG("LOC",LOC) S (LOC,END)="" G LOC1
- W !!,"There are "_COUNT_" active equipment records within the selected range.",!,"Would you like to proceed?"
- S DIR(0)="Y",DIR("B")="YES"
- D ^DIR K DIR I $D(DIRUT) S ESCAPE=1 Q
- S ENY2K("CONT")=Y I 'ENY2K("CONT") L -^ENG("LOC",LOC) S (LOC,END)="" G LOC1
- I COUNT("PRE"),'$D(CRITER) D OVERWRT^ENY2K8
- Q
- ;
- LOCHDR ; header for list of valid LOCAL IDENTIFIERS
- W:PAGE>0!($E(IOST,1,2)="C-") @IOF S PAGE=PAGE+1
- W "LOCAL IDENTIFIERS in Use at this Site "_DATE("PRNT")_" Page: "_PAGE
- K LOC(3) S $P(LOC(3),"-",79)="-" W !,LOC(3)
- Q
- ;
- HOLD Q:$E(IOST,1,2)'="C-"
- W !,"Press <RETURN> to continue, '^' to escape..." R X:DTIME
- I '$T!($E(X)="^") S STOP=1
- Q
- ;ENY2K9
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENY2K9 2541 printed Feb 18, 2025@23:23:44 Page 2
- ENY2K9 ;;(WIRMFO)/DH-Equipment Y2K Management ;5.8.98
- +1 ;;7.0;ENGINEERING;**51**;August 17, 1993
- +2 ; extension of ENY2K to handle local ids
- LOC1 KILL ^TMP($JOB)
- +1 NEW STOP
- +2 READ !!,"Please enter the starting LOCAL ID: ",X:DTIME
- IF '$TEST!($EXTRACT(X)="^")!(X="")
- SET ESCAPE=1
- QUIT
- +3 SET LOC=X
- +4 IF '$DATA(^ENG(6914,"L",LOC))
- Begin DoDot:1
- +5 SET L=$LENGTH(LOC)
- SET LOC(1)=$ORDER(^ENG(6914,"L",LOC))
- +6 IF $EXTRACT(LOC(1),1,L)=LOC
- SET LOC=LOC(1)
- QUIT
- +7 SET LOC=""
- WRITE "??",*7
- +8 SET DIR(0)="Y"
- SET DIR("A")="Would you like a list of valid LOCAL IDs"
- SET DIR("B")="YES"
- +9 DO ^DIR
- KILL DIR
- if 'Y
- QUIT
- +10 SET %ZIS=""
- DO ^%ZIS
- IF POP
- SET ESCAPE=1
- QUIT
- +11 SET PAGE=0
- SET Y=DT
- DO NOW^%DTC
- SET Y=%
- XECUTE ^DD("DD")
- SET DATE("PRNT")=$PIECE(Y,":",1,2)
- +12 DO LOCHDR
- SET LOC(2)=""
- FOR
- SET LOC(2)=$ORDER(^ENG(6914,"L",LOC(2)))
- if LOC(2)=""
- QUIT
- WRITE !,?5,$JUSTIFY(LOC(2),15)
- IF (IOSL-$Y)'>2
- DO HOLD
- DO LOCHDR
- if $GET(STOP)
- QUIT
- End DoDot:1
- if $GET(ESCAPE)
- QUIT
- if LOC=""
- GOTO LOC1
- +13 WRITE " ("_LOC_")"
- LOC2 WRITE !,"Go thru (or '^' to escape): "_LOC_"// "
- READ END:DTIME
- IF '$TEST!($EXTRACT(END)="^")
- SET LOC=""
- GOTO LOC1
- +1 IF LOC]END
- WRITE !!,"The ending point may not preceed the starting point."
- SET (LOC,END)=""
- GOTO LOC1
- +2 LOCK +^ENG("LOC",LOC):1
- IF '$TEST
- WRITE !,"Another user is editing this LOCAL ID. Can't proceed."
- SET (LOC,END)=""
- GOTO LOC1
- +3 FOR J="PRE","FC","NC","CC","NA"
- SET COUNT(J)=0
- +4 SET (DA,COUNT)=0
- SET LOC(0)=LOC
- FOR
- SET DA=$ORDER(^ENG(6914,"L",LOC(0),DA))
- if 'DA
- QUIT
- Begin DoDot:1
- +5 IF $DATA(^ENG(6914,DA,0))
- IF "^4^5^"'[(U_$PIECE($GET(^(3)),U)_U)
- SET COUNT=COUNT+1
- SET ^TMP($JOB,DA)=""
- SET X=$PIECE($GET(^ENG(6914,DA,11)),U)
- IF X]""
- SET COUNT("PRE")=COUNT("PRE")+1
- SET COUNT(X)=COUNT(X)+1
- SET ^TMP($JOB,X,DA)=""
- End DoDot:1
- +6 FOR
- SET LOC(0)=$ORDER(^ENG(6914,"L",LOC(0)))
- if LOC(0)]END!(LOC(0)="")
- QUIT
- SET DA=0
- FOR
- SET DA=$ORDER(^ENG(6914,"L",LOC(0),DA))
- if 'DA
- QUIT
- Begin DoDot:1
- +7 IF $DATA(^ENG(6914,DA,0))
- IF "^4^5^"'[(U_$PIECE($GET(^(3)),U)_U)
- SET COUNT=COUNT+1
- SET ^TMP($JOB,DA)=""
- SET X=$PIECE($GET(^ENG(6914,DA,11)),U)
- IF X]""
- SET COUNT("PRE")=COUNT("PRE")+1
- SET COUNT(J)=COUNT(J)+1
- SET ^TMP($JOB,X,DA)=""
- End DoDot:1
- +8 IF 'COUNT
- WRITE !!,"There are no active equipment records within the selected range."
- LOCK -^ENG("LOC",LOC)
- SET (LOC,END)=""
- GOTO LOC1
- +9 WRITE !!,"There are "_COUNT_" active equipment records within the selected range.",!,"Would you like to proceed?"
- +10 SET DIR(0)="Y"
- SET DIR("B")="YES"
- +11 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- SET ESCAPE=1
- QUIT
- +12 SET ENY2K("CONT")=Y
- IF 'ENY2K("CONT")
- LOCK -^ENG("LOC",LOC)
- SET (LOC,END)=""
- GOTO LOC1
- +13 IF COUNT("PRE")
- IF '$DATA(CRITER)
- DO OVERWRT^ENY2K8
- +14 QUIT
- +15 ;
- LOCHDR ; header for list of valid LOCAL IDENTIFIERS
- +1 if PAGE>0!($EXTRACT(IOST,1,2)="C-")
- WRITE @IOF
- SET PAGE=PAGE+1
- +2 WRITE "LOCAL IDENTIFIERS in Use at this Site "_DATE("PRNT")_" Page: "_PAGE
- +3 KILL LOC(3)
- SET $PIECE(LOC(3),"-",79)="-"
- WRITE !,LOC(3)
- +4 QUIT
- +5 ;
- HOLD if $EXTRACT(IOST,1,2)'="C-"
- QUIT
- +1 WRITE !,"Press <RETURN> to continue, '^' to escape..."
- READ X:DTIME
- +2 IF '$TEST!($EXTRACT(X)="^")
- SET STOP=1
- +3 QUIT
- +4 ;ENY2K9