- ENLBL7 ;(WASH ISC)/DH-Physical Print of Bar Code Label ;10.10.97
- ;;7.0;ENGINEERING;**12,35,45**;Aug 17, 1993
- NXPRT ;Generation of NX barcode labels (equipment)
- I ENBAR("EQUIPMENT DATA")]"" X ENBAR("EQUIPMENT DATA") Q
- NXPRT1 Q:'$D(^ENG(6914,DA,0)) S ENEQBC=ENEQSTA_" EE"_DA
- S ENLBLHD="* EQUIPMENT LABEL *"
- I $D(^DIC(6910,1,0)),$P(^(0),U,8),$D(^ENG(6914,DA,1)),$P(^(1),U)]"" S ENA=$P(^(1),U) S:$D(^ENG(6911,ENA,0)) ENLBLHD=$E($P(^(0),U),1,20)
- S ENLBLBOT=ENEQSTAN D:$O(^DIC(6910,1,1,0))]"" ENLBLBOT
- PRT ;Physical print
- W *2,*27,"E3",!,*24,ENLBLHD,!,ENEQBC,!,ENLBLBOT
- W *23,*3
- Q
- FORMAT ;Equipment labels
- G:'$D(ENEQBY) FORMAT1
- K ENBAR S (ENBAR("EQUIPMENT FORMAT"),ENBAR("EQUIPMENT DATA"))=""
- S ENBCIOS(0)=$O(^DIC(6910.1,"B",ENBCIOS,0)) D:ENBCIOS(0)
- . S ENBAR("EQUIPMENT FORMAT")=$G(^DIC(6910.1,ENBCIOS(0),1))
- . S ENBAR("EQUIPMENT DATA")=$G(^DIC(6910.1,ENBCIOS(0),3))
- I ENBAR("EQUIPMENT FORMAT")]"" X ENBAR("EQUIPMENT FORMAT") Q
- FORMAT1 ;Entry point for location labels
- I $D(ENEQBY),$O(^DIC(6910,1,1,0))]"" S ENEQLM=280
- W *2,*27,"P",*3
- W *2,"E3;F3;"
- W "H0;o0,280;f1;c2;d0,23;h1;w1;"
- W "B1;o23,280;f1;c0,0;h25;w1;i2;d0,20;p@;"
- W "H2;o62,",ENEQLM,";f1;c0;d0,40;h1;w1;"
- W *3
- W *2,"R",*3
- Q
- BCDT ;Record print of Equip Label
- I $D(^ENG("VERSION")),^ENG("VERSION")>6.4 S DIE="^ENG(6914,",DR="28///T" D ^DIE
- Q
- ENLBLBOT ;Locally specified fields (human readable)
- ; in DA = equipment ien
- ; ENLBLBOT = text for bottom line (changed)
- N ENC,ENI,ENX
- S (ENC,ENI)=0
- F S ENI=$O(^DIC(6910,1,1,ENI)) Q:'ENI D Q:ENC=2
- . S ENX=$G(^DIC(6910,1,1,ENI,0))
- . Q:'$P(ENX,U)
- . Q:$$GET1^DID(6914,$P(ENX,U),"","MULTIPLE-VALUED")
- . S ENC=ENC+1
- . S ENLBLBOT=$S(ENC=1:"",1:ENLBLBOT_" ") ; init when 1st, else append
- . S ENLBLBOT=ENLBLBOT_$P(ENX,U,2)_" "_$$GET1^DIQ(6914,DA,$P(ENX,U))
- I $L(ENLBLBOT)>35 S ENLBLBOT=$E(ENLBLBOT,1,34)_"*" ; won't fit on label
- Q
- ;ENLBL7
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENLBL7 1931 printed Feb 18, 2025@23:20:46 Page 2
- ENLBL7 ;(WASH ISC)/DH-Physical Print of Bar Code Label ;10.10.97
- +1 ;;7.0;ENGINEERING;**12,35,45**;Aug 17, 1993
- NXPRT ;Generation of NX barcode labels (equipment)
- +1 IF ENBAR("EQUIPMENT DATA")]""
- XECUTE ENBAR("EQUIPMENT DATA")
- QUIT
- NXPRT1 if '$DATA(^ENG(6914,DA,0))
- QUIT
- SET ENEQBC=ENEQSTA_" EE"_DA
- +1 SET ENLBLHD="* EQUIPMENT LABEL *"
- +2 IF $DATA(^DIC(6910,1,0))
- IF $PIECE(^(0),U,8)
- IF $DATA(^ENG(6914,DA,1))
- IF $PIECE(^(1),U)]""
- SET ENA=$PIECE(^(1),U)
- if $DATA(^ENG(6911,ENA,0))
- SET ENLBLHD=$EXTRACT($PIECE(^(0),U),1,20)
- +3 SET ENLBLBOT=ENEQSTAN
- if $ORDER(^DIC(6910,1,1,0))]""
- DO ENLBLBOT
- PRT ;Physical print
- +1 WRITE *2,*27,"E3",!,*24,ENLBLHD,!,ENEQBC,!,ENLBLBOT
- +2 WRITE *23,*3
- +3 QUIT
- FORMAT ;Equipment labels
- +1 if '$DATA(ENEQBY)
- GOTO FORMAT1
- +2 KILL ENBAR
- SET (ENBAR("EQUIPMENT FORMAT"),ENBAR("EQUIPMENT DATA"))=""
- +3 SET ENBCIOS(0)=$ORDER(^DIC(6910.1,"B",ENBCIOS,0))
- if ENBCIOS(0)
- Begin DoDot:1
- +4 SET ENBAR("EQUIPMENT FORMAT")=$GET(^DIC(6910.1,ENBCIOS(0),1))
- +5 SET ENBAR("EQUIPMENT DATA")=$GET(^DIC(6910.1,ENBCIOS(0),3))
- End DoDot:1
- +6 IF ENBAR("EQUIPMENT FORMAT")]""
- XECUTE ENBAR("EQUIPMENT FORMAT")
- QUIT
- FORMAT1 ;Entry point for location labels
- +1 IF $DATA(ENEQBY)
- IF $ORDER(^DIC(6910,1,1,0))]""
- SET ENEQLM=280
- +2 WRITE *2,*27,"P",*3
- +3 WRITE *2,"E3;F3;"
- +4 WRITE "H0;o0,280;f1;c2;d0,23;h1;w1;"
- +5 WRITE "B1;o23,280;f1;c0,0;h25;w1;i2;d0,20;p@;"
- +6 WRITE "H2;o62,",ENEQLM,";f1;c0;d0,40;h1;w1;"
- +7 WRITE *3
- +8 WRITE *2,"R",*3
- +9 QUIT
- BCDT ;Record print of Equip Label
- +1 IF $DATA(^ENG("VERSION"))
- IF ^ENG("VERSION")>6.4
- SET DIE="^ENG(6914,"
- SET DR="28///T"
- DO ^DIE
- +2 QUIT
- ENLBLBOT ;Locally specified fields (human readable)
- +1 ; in DA = equipment ien
- +2 ; ENLBLBOT = text for bottom line (changed)
- +3 NEW ENC,ENI,ENX
- +4 SET (ENC,ENI)=0
- +5 FOR
- SET ENI=$ORDER(^DIC(6910,1,1,ENI))
- if 'ENI
- QUIT
- Begin DoDot:1
- +6 SET ENX=$GET(^DIC(6910,1,1,ENI,0))
- +7 if '$PIECE(ENX,U)
- QUIT
- +8 if $$GET1^DID(6914,$PIECE(ENX,U),"","MULTIPLE-VALUED")
- QUIT
- +9 SET ENC=ENC+1
- +10 ; init when 1st, else append
- SET ENLBLBOT=$SELECT(ENC=1:"",1:ENLBLBOT_" ")
- +11 SET ENLBLBOT=ENLBLBOT_$PIECE(ENX,U,2)_" "_$$GET1^DIQ(6914,DA,$PIECE(ENX,U))
- End DoDot:1
- if ENC=2
- QUIT
- +12 ; won't fit on label
- IF $LENGTH(ENLBLBOT)>35
- SET ENLBLBOT=$EXTRACT(ENLBLBOT,1,34)_"*"
- +13 QUIT
- +14 ;ENLBL7