- ENLBL3 ;(WASH ISC)/DH-Print Bar Coded Equipment Labels ;10.10.97
- ;;7.0;ENGINEERING;**12,35,45,90**;Aug 17, 1993;Build 25
- ;
- SD ;Single device
- S ENERR=0 D STA G:ENEQSTA="^" QUIT
- N DIC,DIE,DR,DA,FR,TO,X,X1,X2,I,J,K,I1
- N TAG D EN1^ENLBL9 I '$D(ENEQIO),%<0 G EXIT1^ENLBL8
- SD1 D GETEQ^ENUTL
- I Y'>0 S TAG=$S('$D(ENEQIO):"EXIT1",$D(IO(1,ENEQIO)):"EXIT",1:"EXIT1")_"^ENLBL8" G @TAG
- S DA=+Y
- S %ZIS("A")="Select BAR CODE PRINTER: ",%ZIS("B")=$S($D(ENBCIO):ENBCION,1:""),%ZIS="Q" I $D(ENEQIO),ENEQIO=IO S %ZIS=""
- K IO("Q") D ^%ZIS K %ZIS I POP S TAG=$S('$D(ENEQIO):"EXIT1",$D(IO(1,ENEQIO)):"EXIT",1:"EXIT1")_"^ENLBL8" G @TAG
- I $D(ENBCIO),ENBCIO'=IO D
- . N IO,IOSL,IOF,ION,IOST S IO=ENBCIO D ^%ZISC Q
- 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")) D G SD1
- . S:$D(ENEQIO) ENEQY(0)=ENEQY,ENEQPG(0)=ENEQPG,(ENEQY,ENEQPG)=0
- . S ZTIO=ION,ZTRTN="SD2^ENLBL3",ZTSAVE("DA")="",ZTSAVE("EN*")="",ZTDESC="Single Equipment Bar Code Label" D ^%ZTLOAD K ZTSK,IO("Q") D ^%ZISC
- . S:$D(ENEQIO) ENEQY=ENEQY(0),ENEQPG=ENEQPG(0)
- ;HD308658
- SD2 S ENEQBY="Single Label(s)",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
- U ENBCIO D FORMAT^ENLBL7
- D NXPRT^ENLBL7,BCDT^ENLBL7 D:$D(ENEQIO) CPRNT^ENLBL9
- G:$D(ZTQUEUED) EXIT^ENLBL8
- D HOME^%ZIS U IO G SD1
- ;
- CAT ;Complete Equip Category
- S ENERR=0 D STA G:ENEQSTA="^" QUIT
- N DIC,DIE,DA,DR,FR,TO,X,X1,X2,I,J,K,I1
- D EN^ENLBL9 G:$D(DIRUT) EXIT1^ENLBL8
- I '$D(ENEQIO),%<0 G EXIT1^ENLBL8
- K ENEQDA
- CAT1 S DIC="^ENG(6911,",DIC(0)="AEMQ" D ^DIC
- I Y'>0 G EXIT1^ENLBL8
- S ENEQDA=+Y
- S ENLOCSRT=1
- CAT11 W !,"Sort labels by LOCATION" S %=1 D YN^DICN G:%<0 EXIT1^ENLBL8 I %=0 W !,"Say YES to sort labels by BUILDING, then by ROOM within BUILDING.",!,"If you say NO, labels will be sorted by EQUIPMENT ID#." G CAT11
- S:%=2 ENLOCSRT=0
- S %ZIS("A")="Select BARCODE 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")) S ZTIO=ION,ZTRTN="CAT2^ENLBL3",ZTSAVE("EN*")="",ZTDESC="Barcode Labels by CATEGORY" D ^%ZTLOAD K ZTSK,IO("Q") G EXIT1^ENLBL8
- ;HD308658
- CAT2 G:'$D(^ENG(6911,ENEQDA,0)) EXIT1^ENLBL8 S ENEQBY="Equip Cat: "_$P(^ENG(6911,ENEQDA,0),U,1),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) S I1=0 F J1=0:0 S I1=$O(^ENG(6914,"G",ENEQDA,I1)) Q:I1'>0 S DA=I1 D STATCK I DA]"" D SORT D:'(DA#10) DOTS
- I $D(^TMP($J)) U ENBCIO D FORMAT^ENLBL7 S I1="" F J1=0:0 S I1=$O(^TMP($J,I1)) Q:I1="" F DA=0:0 S DA=$O(^TMP($J,I1,DA)) Q:DA'>0 U ENBCIO D NXPRT^ENLBL7 D:$D(ENEQIO) CPRNT^ENLBL9 D:'(DA#10) DOTS D BCDT^ENLBL7
- G EXIT^ENLBL8
- ;
- SORT I 'ENLOCSRT S ^TMP($J,DA,DA)="" Q
- S X=$S($D(^ENG(6914,DA,3)):$P(^(3),U,5),1:0) S:X="" X=0
- G:X=0 SORT1
- I X=+X,$D(^ENG("SP",X,0)) D G SORT1
- . I $D(^ENG("SP",X,9)) S X(0)=$P(^(9),U) I X(0)]"" S X=X(0) Q
- . S X=$P(^ENG("SP",X,0),U) F I=1,2,3 S X(I)=$P(X,"-",I)
- . S X=X(3)_":"_X(2)_":"_X(1)
- F I=1,2,3 S X(I)=$P(X,"-",I)
- S X=X(3)_":"_X(2)_":"_X(1)
- SORT1 S ^TMP($J,X,DA)=""
- Q
- ;
- STATCK S:'$D(^ENG(6914,DA,0)) DA="" I DA]"" S ENA=$G(^(3)) D:ENA]"" Q
- . I $P(ENA,U)>3,$P(ENA,U)<6 S DA="" Q
- . I $G(ENEQREP),$P(ENA,U,10)]"" S DA=""
- ;
- STA I $D(^DIC(6910,1,0)),$P(^(0),U,2)]"" S ENEQSTA=$P(^(0),U,2)
- E S ENEQSTA="^"
- I ENEQSTA'="^" S ENEQSTAN="DVAMC "_$P(^DIC(6910,1,0),U),ENEQLM=(135+(4*$L(ENEQSTAN)))
- Q
- ;
- DOTS ;Act indic
- Q:$D(ZTQUEUED)
- I '$D(ENEQIO) U IO(0) W "." Q
- I ENEQIO'=IO(0) U IO(0) W "."
- Q
- ;
- HOLD W !,"Press <RETURN> to continue..." R X:DTIME
- Q
- ;
- QUIT I $D(ENEQSTA),ENEQSTA="^" W !!,"Can't seem to find your Station Number. Please check File 6910 (ENG INIT",!,"PARAMETERS).",*7
- G EXIT1^ENLBL8
- ;ENLBL3
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENLBL3 4041 printed Jan 18, 2025@02:55:31 Page 2
- ENLBL3 ;(WASH ISC)/DH-Print Bar Coded Equipment Labels ;10.10.97
- +1 ;;7.0;ENGINEERING;**12,35,45,90**;Aug 17, 1993;Build 25
- +2 ;
- SD ;Single device
- +1 SET ENERR=0
- DO STA
- if ENEQSTA="^"
- GOTO QUIT
- +2 NEW DIC,DIE,DR,DA,FR,TO,X,X1,X2,I,J,K,I1
- +3 NEW TAG
- DO EN1^ENLBL9
- IF '$DATA(ENEQIO)
- IF %<0
- GOTO EXIT1^ENLBL8
- SD1 DO GETEQ^ENUTL
- +1 IF Y'>0
- SET TAG=$SELECT('$DATA(ENEQIO):"EXIT1",$DATA(IO(1,ENEQIO)):"EXIT",1:"EXIT1")_"^ENLBL8"
- GOTO @TAG
- +2 SET DA=+Y
- +3 SET %ZIS("A")="Select BAR CODE PRINTER: "
- SET %ZIS("B")=$SELECT($DATA(ENBCIO):ENBCION,1:"")
- SET %ZIS="Q"
- IF $DATA(ENEQIO)
- IF ENEQIO=IO
- SET %ZIS=""
- +4 KILL IO("Q")
- DO ^%ZIS
- KILL %ZIS
- IF POP
- SET TAG=$SELECT('$DATA(ENEQIO):"EXIT1",$DATA(IO(1,ENEQIO)):"EXIT",1:"EXIT1")_"^ENLBL8"
- GOTO @TAG
- +5 IF $DATA(ENBCIO)
- IF ENBCIO'=IO
- Begin DoDot:1
- +6 NEW IO,IOSL,IOF,ION,IOST
- SET IO=ENBCIO
- DO ^%ZISC
- QUIT
- End DoDot:1
- +7 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")
- +8 IF $DATA(IO("Q"))
- Begin DoDot:1
- +9 if $DATA(ENEQIO)
- SET ENEQY(0)=ENEQY
- SET ENEQPG(0)=ENEQPG
- SET (ENEQY,ENEQPG)=0
- +10 SET ZTIO=ION
- SET ZTRTN="SD2^ENLBL3"
- SET ZTSAVE("DA")=""
- SET ZTSAVE("EN*")=""
- SET ZTDESC="Single Equipment Bar Code Label"
- DO ^%ZTLOAD
- KILL ZTSK,IO("Q")
- DO ^%ZISC
- +11 if $DATA(ENEQIO)
- SET ENEQY=ENEQY(0)
- SET ENEQPG=ENEQPG(0)
- End DoDot:1
- GOTO SD1
- +12 ;HD308658
- SD2 SET ENEQBY="Single Label(s)"
- 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 USE ENBCIO
- DO FORMAT^ENLBL7
- +3 DO NXPRT^ENLBL7
- DO BCDT^ENLBL7
- if $DATA(ENEQIO)
- DO CPRNT^ENLBL9
- +4 if $DATA(ZTQUEUED)
- GOTO EXIT^ENLBL8
- +5 DO HOME^%ZIS
- USE IO
- GOTO SD1
- +6 ;
- CAT ;Complete Equip Category
- +1 SET ENERR=0
- DO STA
- if ENEQSTA="^"
- GOTO QUIT
- +2 NEW DIC,DIE,DA,DR,FR,TO,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 KILL ENEQDA
- CAT1 SET DIC="^ENG(6911,"
- SET DIC(0)="AEMQ"
- DO ^DIC
- +1 IF Y'>0
- GOTO EXIT1^ENLBL8
- +2 SET ENEQDA=+Y
- +3 SET ENLOCSRT=1
- CAT11 WRITE !,"Sort labels by LOCATION"
- SET %=1
- DO YN^DICN
- if %<0
- GOTO EXIT1^ENLBL8
- IF %=0
- WRITE !,"Say YES to sort labels by BUILDING, then by ROOM within BUILDING.",!,"If you say NO, labels will be sorted by EQUIPMENT ID#."
- GOTO CAT11
- +1 if %=2
- SET ENLOCSRT=0
- +2 SET %ZIS("A")="Select BARCODE 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"))
- SET ZTIO=ION
- SET ZTRTN="CAT2^ENLBL3"
- SET ZTSAVE("EN*")=""
- SET ZTDESC="Barcode Labels by CATEGORY"
- DO ^%ZTLOAD
- KILL ZTSK,IO("Q")
- GOTO EXIT1^ENLBL8
- +6 ;HD308658
- CAT2 if '$DATA(^ENG(6911,ENEQDA,0))
- GOTO EXIT1^ENLBL8
- SET ENEQBY="Equip Cat: "_$PIECE(^ENG(6911,ENEQDA,0),U,1)
- 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)
- SET I1=0
- FOR J1=0:0
- SET I1=$ORDER(^ENG(6914,"G",ENEQDA,I1))
- if I1'>0
- QUIT
- SET DA=I1
- DO STATCK
- IF DA]""
- DO SORT
- if '(DA#10)
- DO DOTS
- +3 IF $DATA(^TMP($JOB))
- USE ENBCIO
- DO FORMAT^ENLBL7
- SET I1=""
- FOR J1=0:0
- SET I1=$ORDER(^TMP($JOB,I1))
- if I1=""
- QUIT
- FOR DA=0:0
- 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
- DO BCDT^ENLBL7
- +4 GOTO EXIT^ENLBL8
- +5 ;
- SORT IF 'ENLOCSRT
- SET ^TMP($JOB,DA,DA)=""
- QUIT
- +1 SET X=$SELECT($DATA(^ENG(6914,DA,3)):$PIECE(^(3),U,5),1:0)
- if X=""
- SET X=0
- +2 if X=0
- GOTO SORT1
- +3 IF X=+X
- IF $DATA(^ENG("SP",X,0))
- Begin DoDot:1
- +4 IF $DATA(^ENG("SP",X,9))
- SET X(0)=$PIECE(^(9),U)
- IF X(0)]""
- SET X=X(0)
- QUIT
- +5 SET X=$PIECE(^ENG("SP",X,0),U)
- FOR I=1,2,3
- SET X(I)=$PIECE(X,"-",I)
- +6 SET X=X(3)_":"_X(2)_":"_X(1)
- End DoDot:1
- GOTO SORT1
- +7 FOR I=1,2,3
- SET X(I)=$PIECE(X,"-",I)
- +8 SET X=X(3)_":"_X(2)_":"_X(1)
- SORT1 SET ^TMP($JOB,X,DA)=""
- +1 QUIT
- +2 ;
- STATCK if '$DATA(^ENG(6914,DA,0))
- SET DA=""
- IF DA]""
- SET ENA=$GET(^(3))
- if ENA]""
- Begin DoDot:1
- +1 IF $PIECE(ENA,U)>3
- IF $PIECE(ENA,U)<6
- SET DA=""
- QUIT
- +2 IF $GET(ENEQREP)
- IF $PIECE(ENA,U,10)]""
- SET DA=""
- End DoDot:1
- QUIT
- +3 ;
- STA IF $DATA(^DIC(6910,1,0))
- IF $PIECE(^(0),U,2)]""
- SET ENEQSTA=$PIECE(^(0),U,2)
- +1 IF '$TEST
- SET ENEQSTA="^"
- +2 IF ENEQSTA'="^"
- SET ENEQSTAN="DVAMC "_$PIECE(^DIC(6910,1,0),U)
- SET ENEQLM=(135+(4*$LENGTH(ENEQSTAN)))
- +3 QUIT
- +4 ;
- DOTS ;Act indic
- +1 if $DATA(ZTQUEUED)
- QUIT
- +2 IF '$DATA(ENEQIO)
- USE IO(0)
- WRITE "."
- QUIT
- +3 IF ENEQIO'=IO(0)
- USE IO(0)
- WRITE "."
- +4 QUIT
- +5 ;
- HOLD WRITE !,"Press <RETURN> to continue..."
- READ X:DTIME
- +1 QUIT
- +2 ;
- QUIT IF $DATA(ENEQSTA)
- IF ENEQSTA="^"
- WRITE !!,"Can't seem to find your Station Number. Please check File 6910 (ENG INIT",!,"PARAMETERS).",*7
- +1 GOTO EXIT1^ENLBL8
- +2 ;ENLBL3