- ENLBL15 ;(WASH ISC)/DH-Print Bar Coded Equipment Labels ;10.10.97
- ;;7.0;ENGINEERING;**12,35,45,90**;Aug 17, 1993;Build 25
- LOCID ;By LOCAL IDENTIFIER
- S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3
- N DIC,DIE,DA,DR,X,X1,X2,I,J,K,I1
- D EN^ENLBL9 I $D(DIRUT) G EXIT1^ENLBL8
- I '$D(ENEQIO),%<0 G EXIT1^ENLBL8
- S DIC="^ENG(6914,",ENDX="L",ENLOCSRT=1
- LOCID1 S (X,ENLID)="" R !,"Start with: ",X:DTIME G:X="^"!(X="") EXIT1^ENLBL8 S:X=" " X="?" G:$E(X)="?" LOCID15
- S X2=$L(X) I $D(^ENG(6914,"L",X)) S ENLID("FR")=X G LOCID2
- I $E($O(^ENG(6914,"L",X)),1,X2)=X D IX^ENLIB1 G:X="" LOCID1 G:X="^" EXIT1^ENLBL8 S ENLID("FR")=X W " ",ENLID("FR") G LOCID2
- S ENX=X,ENIX=0 I X?.N D IX^ENLIB1 G:X="^" EXIT1^ENLBL8 I $E(X,1,X2)=ENX S ENLID("FR")=X W " ",ENLID("FR") G LOCID2
- I 'ENIX W !,"There is no LOCAL IDENTIFIER in the Equipment File that begins with:",!,?5,ENX
- K ENIX
- LOCID15 W !,"Would you like a list of all LOCAL IDENTIFIERS" S %=1 D YN^DICN S:%<0 X="^" G:%<0 EXIT1^ENLBL8 G:%'=1 LOCID1
- S X="" D IX^ENLIB1 G:X="" LOCID1 G:X="^" EXIT1^ENLBL8 S ENLID("FR")=X W " ",ENLID("FR")
- LOCID2 S X="" R !,"Go to: ",X:DTIME G:X="^"!(X="") EXIT1^ENLBL8 S:X=" " X="?"
- I $E(X)="?" W !,"Please enter a character string which follows (or equals):",!,ENLID("FR"),!,"This will be the end point of our print job." G LOCID2
- I ENLID("FR")?.N,$L(X)>0,X'?.N G LOCID25
- I ENLID("FR")?.N,X?.N,X'<ENLID("FR") G LOCID25
- I ENLID("FR")]X W !,"Your entry (",X,") does not follow ",ENLID("FR"),".",*7 G LOCID2
- LOCID25 S ENLID("TO")=X W !,"OK, including everything from ",ENLID("FR")," to ",ENLID("TO"),"."
- LOCID3 W !,"Sort labels by LOCATION" S %=1 D YN^DICN G:%<0 EXIT1^ENLBL8 I %=0 W !,"Say YES to sort labels by DIVISION, BUILDING, and then by ROOM.",!,"If you say NO, labels will be sorted by LOCAL IDENTIFIER." G LOCID3
- S:%=2 ENLOCSRT=0
- S %ZIS("A")="Select BAR CODE PRINTER: ",%ZIS("B")="",%ZIS="Q" I $D(ENEQIO),ENEQIO=IO S %ZIS=""
- K IO("Q") D ^%ZIS K %ZIS G:POP EXIT1^ENLBL8
- S ENBCIO=IO,ENBCIOSL=IOSL,ENBCIOF=IOF,ENBCION=ION,ENBCIOST=IOST,ENBCIOST(0)=IOST(0),ENBCIOS=IOS S:$D(IO("S")) ENBCIO("S")=IO("S")
- I $D(IO("Q")) K IO("Q") S ZTIO=ION,ZTRTN="LOCID4^ENLBL15",ZTSAVE("EN*")="",ZTDESC="All Equipment Labels (Bar Code)" D ^%ZTLOAD K ZTSK G EXIT1^ENLBL8
- ;HD308658
- LOCID4 S ENEQBY="Local Identifier: "_ENLID("FR")_" to "_ENLID("TO")_".",ENBCIO=IO
- I $D(ENEQIO) D OPEN^ENLBL9 I POP G:$D(ZTQUEUED) REQ^ENLBL8 W !,*7,"Companion Printer UNAVAILABLE." D HOLD G EXIT1^ENLBL8
- K ^TMP($J) I $D(^ENG(6914,"L",ENLID("FR"))) S I1=ENLID("FR"),ENDA=0 F S ENDA=$O(^ENG(6914,"L",I1,ENDA)) Q:ENDA'>0 S DA=ENDA D STATCK^ENLBL3 I DA]"" D:ENLOCSRT SORT^ENLBL3 I 'ENLOCSRT D LIDSRT
- I $G(I1)]"" F S I1=$O(^ENG(6914,"L",I1)) Q:I1="" D NEXT Q:I1="" S ENDA=0 F S ENDA=$O(^ENG(6914,"L",I1,ENDA)) Q:ENDA'>0 S DA=ENDA D STATCK^ENLBL3 I DA]"" D:ENLOCSRT SORT^ENLBL3 D:'(ENDA#10) DOTS^ENLBL3 I 'ENLOCSRT D LIDSRT
- I $D(^TMP($J)) U ENBCIO D FORMAT^ENLBL7 S I1="" F S I1=$O(^TMP($J,I1)) Q:I1="" S DA=0 F S DA=$O(^TMP($J,I1,DA)) Q:DA'>0 U ENBCIO D NXPRT^ENLBL7 D:$D(ENEQIO) CPRNT^ENLBL9 D:'(DA#10) DOTS^ENLBL3 D BCDT^ENLBL7
- G EXIT^ENLBL8
- ;
- NEXT ;Time to quit?
- I I1=+I1,ENLID("TO")'=+ENLID("TO") Q
- I I1=+I1,ENLID("TO")=+ENLID("TO") S:I1>ENLID("TO") I1="" Q
- I I1'=+I1,ENLID("TO")=+ENLID("TO") S I1="" Q
- I I1]ENLID("TO") S I1=""
- Q
- ;
- LIDSRT S ^TMP($J,I1,DA)="" Q
- HOLD W !,"Press <RETURN> to continue..." R X:DTIME
- Q
- ;ENLBL15
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENLBL15 3442 printed Apr 23, 2025@18:08:44 Page 2
- ENLBL15 ;(WASH ISC)/DH-Print Bar Coded Equipment Labels ;10.10.97
- +1 ;;7.0;ENGINEERING;**12,35,45,90**;Aug 17, 1993;Build 25
- LOCID ;By LOCAL IDENTIFIER
- +1 SET ENERR=0
- DO STA^ENLBL3
- if ENEQSTA="^"
- GOTO QUIT^ENLBL3
- +2 NEW DIC,DIE,DA,DR,X,X1,X2,I,J,K,I1
- +3 DO EN^ENLBL9
- IF $DATA(DIRUT)
- GOTO EXIT1^ENLBL8
- +4 IF '$DATA(ENEQIO)
- IF %<0
- GOTO EXIT1^ENLBL8
- +5 SET DIC="^ENG(6914,"
- SET ENDX="L"
- SET ENLOCSRT=1
- LOCID1 SET (X,ENLID)=""
- READ !,"Start with: ",X:DTIME
- if X="^"!(X="")
- GOTO EXIT1^ENLBL8
- if X=" "
- SET X="?"
- if $EXTRACT(X)="?"
- GOTO LOCID15
- +1 SET X2=$LENGTH(X)
- IF $DATA(^ENG(6914,"L",X))
- SET ENLID("FR")=X
- GOTO LOCID2
- +2 IF $EXTRACT($ORDER(^ENG(6914,"L",X)),1,X2)=X
- DO IX^ENLIB1
- if X=""
- GOTO LOCID1
- if X="^"
- GOTO EXIT1^ENLBL8
- SET ENLID("FR")=X
- WRITE " ",ENLID("FR")
- GOTO LOCID2
- +3 SET ENX=X
- SET ENIX=0
- IF X?.N
- DO IX^ENLIB1
- if X="^"
- GOTO EXIT1^ENLBL8
- IF $EXTRACT(X,1,X2)=ENX
- SET ENLID("FR")=X
- WRITE " ",ENLID("FR")
- GOTO LOCID2
- +4 IF 'ENIX
- WRITE !,"There is no LOCAL IDENTIFIER in the Equipment File that begins with:",!,?5,ENX
- +5 KILL ENIX
- LOCID15 WRITE !,"Would you like a list of all LOCAL IDENTIFIERS"
- SET %=1
- DO YN^DICN
- if %<0
- SET X="^"
- if %<0
- GOTO EXIT1^ENLBL8
- if %'=1
- GOTO LOCID1
- +1 SET X=""
- DO IX^ENLIB1
- if X=""
- GOTO LOCID1
- if X="^"
- GOTO EXIT1^ENLBL8
- SET ENLID("FR")=X
- WRITE " ",ENLID("FR")
- LOCID2 SET X=""
- READ !,"Go to: ",X:DTIME
- if X="^"!(X="")
- GOTO EXIT1^ENLBL8
- if X=" "
- SET X="?"
- +1 IF $EXTRACT(X)="?"
- WRITE !,"Please enter a character string which follows (or equals):",!,ENLID("FR"),!,"This will be the end point of our print job."
- GOTO LOCID2
- +2 IF ENLID("FR")?.N
- IF $LENGTH(X)>0
- IF X'?.N
- GOTO LOCID25
- +3 IF ENLID("FR")?.N
- IF X?.N
- IF X'<ENLID("FR")
- GOTO LOCID25
- +4 IF ENLID("FR")]X
- WRITE !,"Your entry (",X,") does not follow ",ENLID("FR"),".",*7
- GOTO LOCID2
- LOCID25 SET ENLID("TO")=X
- WRITE !,"OK, including everything from ",ENLID("FR")," to ",ENLID("TO"),"."
- LOCID3 WRITE !,"Sort labels by LOCATION"
- SET %=1
- DO YN^DICN
- if %<0
- GOTO EXIT1^ENLBL8
- IF %=0
- WRITE !,"Say YES to sort labels by DIVISION, BUILDING, and then by ROOM.",!,"If you say NO, labels will be sorted by LOCAL IDENTIFIER."
- GOTO LOCID3
- +1 if %=2
- SET ENLOCSRT=0
- +2 SET %ZIS("A")="Select BAR CODE PRINTER: "
- SET %ZIS("B")=""
- SET %ZIS="Q"
- IF $DATA(ENEQIO)
- IF ENEQIO=IO
- SET %ZIS=""
- +3 KILL IO("Q")
- DO ^%ZIS
- KILL %ZIS
- if POP
- GOTO EXIT1^ENLBL8
- +4 SET ENBCIO=IO
- SET ENBCIOSL=IOSL
- SET ENBCIOF=IOF
- SET ENBCION=ION
- SET ENBCIOST=IOST
- SET ENBCIOST(0)=IOST(0)
- SET ENBCIOS=IOS
- if $DATA(IO("S"))
- SET ENBCIO("S")=IO("S")
- +5 IF $DATA(IO("Q"))
- KILL IO("Q")
- SET ZTIO=ION
- SET ZTRTN="LOCID4^ENLBL15"
- SET ZTSAVE("EN*")=""
- SET ZTDESC="All Equipment Labels (Bar Code)"
- DO ^%ZTLOAD
- KILL ZTSK
- GOTO EXIT1^ENLBL8
- +6 ;HD308658
- LOCID4 SET ENEQBY="Local Identifier: "_ENLID("FR")_" to "_ENLID("TO")_"."
- SET ENBCIO=IO
- +1 IF $DATA(ENEQIO)
- DO OPEN^ENLBL9
- IF POP
- if $DATA(ZTQUEUED)
- GOTO REQ^ENLBL8
- WRITE !,*7,"Companion Printer UNAVAILABLE."
- DO HOLD
- GOTO EXIT1^ENLBL8
- +2 KILL ^TMP($JOB)
- IF $DATA(^ENG(6914,"L",ENLID("FR")))
- SET I1=ENLID("FR")
- SET ENDA=0
- FOR
- SET ENDA=$ORDER(^ENG(6914,"L",I1,ENDA))
- if ENDA'>0
- QUIT
- SET DA=ENDA
- DO STATCK^ENLBL3
- IF DA]""
- if ENLOCSRT
- DO SORT^ENLBL3
- IF 'ENLOCSRT
- DO LIDSRT
- +3 IF $GET(I1)]""
- FOR
- SET I1=$ORDER(^ENG(6914,"L",I1))
- if I1=""
- QUIT
- DO NEXT
- if I1=""
- QUIT
- SET ENDA=0
- FOR
- SET ENDA=$ORDER(^ENG(6914,"L",I1,ENDA))
- if ENDA'>0
- QUIT
- SET DA=ENDA
- DO STATCK^ENLBL3
- IF DA]""
- if ENLOCSRT
- DO SORT^ENLBL3
- if '(ENDA#10)
- DO DOTS^ENLBL3
- IF 'ENLOCSRT
- DO LIDSRT
- +4 IF $DATA(^TMP($JOB))
- USE ENBCIO
- DO FORMAT^ENLBL7
- SET I1=""
- FOR
- SET I1=$ORDER(^TMP($JOB,I1))
- if I1=""
- QUIT
- SET DA=0
- FOR
- SET DA=$ORDER(^TMP($JOB,I1,DA))
- if DA'>0
- QUIT
- USE ENBCIO
- DO NXPRT^ENLBL7
- if $DATA(ENEQIO)
- DO CPRNT^ENLBL9
- if '(DA#10)
- DO DOTS^ENLBL3
- DO BCDT^ENLBL7
- +5 GOTO EXIT^ENLBL8
- +6 ;
- NEXT ;Time to quit?
- +1 IF I1=+I1
- IF ENLID("TO")'=+ENLID("TO")
- QUIT
- +2 IF I1=+I1
- IF ENLID("TO")=+ENLID("TO")
- if I1>ENLID("TO")
- SET I1=""
- QUIT
- +3 IF I1'=+I1
- IF ENLID("TO")=+ENLID("TO")
- SET I1=""
- QUIT
- +4 IF I1]ENLID("TO")
- SET I1=""
- +5 QUIT
- +6 ;
- LIDSRT SET ^TMP($JOB,I1,DA)=""
- QUIT
- HOLD WRITE !,"Press <RETURN> to continue..."
- READ X:DTIME
- +1 QUIT
- +2 ;ENLBL15
