- ENLBL9 ;(WASH ISC)/DH-Companion Listing for Equipment Labels ;11.27.96
- ;;7.0;ENGINEERING;**12,35,80,90**;Aug 17, 1993;Build 25
- ; Print companion list (if desired)
- ; Also asks if previously printed labels should be reprinted
- EN S DIR(0)="Y",DIR("A")="New labels only",DIR("B")="YES"
- S DIR("?",1)="The system records the printing of equipment bar code labels. If you do not"
- S DIR("?",2)="wish to have labels printed again if they have already been printed at least"
- S DIR("?")="once, please enter 'YES' at this time."
- D ^DIR K DIR Q:$D(DIRUT)
- S ENEQREP=+Y
- EN1 K ENEQIO W !,"Would you like a companion listing for this set of labels" S %=1 D YN^DICN Q:%=2!(%<0) I %<1 D HLP G EN
- S %ZIS("A")="Select PRINTER for Companion Listing: ",%ZIS="NQ",%ZIS("B")="" D ^%ZIS K %ZIS I POP D ERR G EN
- I IOM<80 D HOME^%ZIS W !,*7,"Device selected must have a MARGIN WIDTH of at least 80 char.",!! G EN
- I $E(^%ZOSF("OS"),1,3)="MSM",IO=IO(0) D ^%ZISC W !,*7,"MSM sites may not send Companion List to HOME device.",!! G EN
- S ENEQIO=IO,ENEQIOSL=IOSL,ENEQIOF=IOF,ENEQION=ION,ENEQIOST=IOST,ENEQIOST(0)=IOST(0),ENEQPG=0,ENEQY=0 S:$D(IO("S")) ENEQIO("S")=IO("S") S X="N",%DT="T" D ^%DT X ^DD("DD") S ENEQDATE=Y,ENHDMRGN=79-$L(ENEQDATE)
- D HOME^%ZIS
- I $D(DUZ),$D(^VA(200,DUZ,0)) S ENEQUSER=$P(^(0),U)
- E S ENEQUSER=""
- Q
- ;
- CPRNT ;I $D(^ENG(6914,DA,3)),$P(^(3),U,10)]"" Q ;Suppress if already printed
- ;I $F(ENEQIO,"/") S ENEQIO=$P(ENEQIO,"/",$L(ENEQIO,"/"))
- U ENEQIO I ENEQY=0!((ENEQIOSL-ENEQY)<8) D CHDR
- K EN S (ENMAN,ENMOD,ENSN,ENCAT,ENUSE,ENSER,ENLOC,ENPMN)="",ENMEN=$P(^ENG(6914,DA,0),U,2) S:$D(^ENG(6914,DA,1)) EN(1)=^(1) S:$D(^(3)) EN(3)=^(3)
- I $D(EN(1)) S ENMAN=$P(EN(1),U,4),ENMOD=$P(EN(1),U,2),ENSN=$P(EN(1),U,3),ENCAT=$P(EN(1),U,1)
- S:ENMAN]"" ENMAN=$P(^ENG("MFG",ENMAN,0),U,1) S:ENCAT]"" ENCAT=$P(^ENG(6911,ENCAT,0),U,1)
- I $D(EN(3)) S ENUSE=$P(EN(3),U,1),ENSER=$P(EN(3),U,2),ENLOC=$P(EN(3),U,5),ENPMN=$P(EN(3),U,6) S:ENUSE]"" ENUSE=$P($P(^DD(6914,20,0),U,3),";",ENUSE) I ENSER]"",$D(^DIC(49,ENSER)) S ENSER=$P(^DIC(49,ENSER,0),U,1)
- I ENLOC=+ENLOC,$D(^ENG("SP",ENLOC,0)) S ENLOC=$P(^(0),U)
- W !!,DA,?15,$E(ENMEN,1,60),!,?5,"Man: ",$E(ENMAN,1,30),?40,"Cat: ",$E(ENCAT,1,35)
- W !,?5,"Model: ",$E(ENMOD,1,28),?40,"S/N: ",$E(ENSN,1,35),!,?5,"Servc: ",$E(ENSER,1,28),?40,"Status: ",$P(ENUSE,":",2),!,?5,"Location: ",$E(ENLOC,1,25),?40,"PM#: ",ENPMN
- S ENEQY=ENEQY+6 K EN
- D:$O(^DIC(6910,1,2,0))]"" LOC1^ENLBL16
- Q
- CHDR W:ENEQPG @ENEQIOF S ENEQPG=ENEQPG+1 W "COMPANION LISTING (Bar Code Labels)",?ENHDMRGN,"Page ",ENEQPG
- W !,ENEQBY W:$L(ENEQBY)<41 " (",$S(ENEQUSER]"":$E(ENEQUSER,1,20),1:"User unknown"),")" W ?ENHDMRGN,ENEQDATE,!,"Equip ID",?15,"* Description *"
- S X="",$P(X,"-",80)="-" W !,X
- S ENEQY=0
- Q
- HLP W !!,"A 'companion listing' is simply a printout on regular paper (must be at",!,"least 80 columns wide) that is intended for use in the initial application"
- W !,"of the actual bar code labels to individual equipment items. The companion",!,"listing will contain more descriptive information than can be printed"
- W !,"on the labels themselves, and will be sorted in the same order as the",!,"labels."
- Q
- OPEN ;
- S IOP=ENEQION D ^%ZIS K IOP
- S ENEQIO=IO ;HD308658
- Q
- ERR W !,*7,"Device selection unsuccessful.",!
- Q
- ;ENLBL9
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENLBL9 3293 printed Feb 18, 2025@23:20:47 Page 2
- ENLBL9 ;(WASH ISC)/DH-Companion Listing for Equipment Labels ;11.27.96
- +1 ;;7.0;ENGINEERING;**12,35,80,90**;Aug 17, 1993;Build 25
- +2 ; Print companion list (if desired)
- +3 ; Also asks if previously printed labels should be reprinted
- EN SET DIR(0)="Y"
- SET DIR("A")="New labels only"
- SET DIR("B")="YES"
- +1 SET DIR("?",1)="The system records the printing of equipment bar code labels. If you do not"
- +2 SET DIR("?",2)="wish to have labels printed again if they have already been printed at least"
- +3 SET DIR("?")="once, please enter 'YES' at this time."
- +4 DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- QUIT
- +5 SET ENEQREP=+Y
- EN1 KILL ENEQIO
- WRITE !,"Would you like a companion listing for this set of labels"
- SET %=1
- DO YN^DICN
- if %=2!(%<0)
- QUIT
- IF %<1
- DO HLP
- GOTO EN
- +1 SET %ZIS("A")="Select PRINTER for Companion Listing: "
- SET %ZIS="NQ"
- SET %ZIS("B")=""
- DO ^%ZIS
- KILL %ZIS
- IF POP
- DO ERR
- GOTO EN
- +2 IF IOM<80
- DO HOME^%ZIS
- WRITE !,*7,"Device selected must have a MARGIN WIDTH of at least 80 char.",!!
- GOTO EN
- +3 IF $EXTRACT(^%ZOSF("OS"),1,3)="MSM"
- IF IO=IO(0)
- DO ^%ZISC
- WRITE !,*7,"MSM sites may not send Companion List to HOME device.",!!
- GOTO EN
- +4 SET ENEQIO=IO
- SET ENEQIOSL=IOSL
- SET ENEQIOF=IOF
- SET ENEQION=ION
- SET ENEQIOST=IOST
- SET ENEQIOST(0)=IOST(0)
- SET ENEQPG=0
- SET ENEQY=0
- if $DATA(IO("S"))
- SET ENEQIO("S")=IO("S")
- SET X="N"
- SET %DT="T"
- DO ^%DT
- XECUTE ^DD("DD")
- SET ENEQDATE=Y
- SET ENHDMRGN=79-$LENGTH(ENEQDATE)
- +5 DO HOME^%ZIS
- +6 IF $DATA(DUZ)
- IF $DATA(^VA(200,DUZ,0))
- SET ENEQUSER=$PIECE(^(0),U)
- +7 IF '$TEST
- SET ENEQUSER=""
- +8 QUIT
- +9 ;
- CPRNT ;I $D(^ENG(6914,DA,3)),$P(^(3),U,10)]"" Q ;Suppress if already printed
- +1 ;I $F(ENEQIO,"/") S ENEQIO=$P(ENEQIO,"/",$L(ENEQIO,"/"))
- +2 USE ENEQIO
- IF ENEQY=0!((ENEQIOSL-ENEQY)<8)
- DO CHDR
- +3 KILL EN
- SET (ENMAN,ENMOD,ENSN,ENCAT,ENUSE,ENSER,ENLOC,ENPMN)=""
- SET ENMEN=$PIECE(^ENG(6914,DA,0),U,2)
- if $DATA(^ENG(6914,DA,1))
- SET EN(1)=^(1)
- if $DATA(^(3))
- SET EN(3)=^(3)
- +4 IF $DATA(EN(1))
- SET ENMAN=$PIECE(EN(1),U,4)
- SET ENMOD=$PIECE(EN(1),U,2)
- SET ENSN=$PIECE(EN(1),U,3)
- SET ENCAT=$PIECE(EN(1),U,1)
- +5 if ENMAN]""
- SET ENMAN=$PIECE(^ENG("MFG",ENMAN,0),U,1)
- if ENCAT]""
- SET ENCAT=$PIECE(^ENG(6911,ENCAT,0),U,1)
- +6 IF $DATA(EN(3))
- SET ENUSE=$PIECE(EN(3),U,1)
- SET ENSER=$PIECE(EN(3),U,2)
- SET ENLOC=$PIECE(EN(3),U,5)
- SET ENPMN=$PIECE(EN(3),U,6)
- if ENUSE]""
- SET ENUSE=$PIECE($PIECE(^DD(6914,20,0),U,3),";",ENUSE)
- IF ENSER]""
- IF $DATA(^DIC(49,ENSER))
- SET ENSER=$PIECE(^DIC(49,ENSER,0),U,1)
- +7 IF ENLOC=+ENLOC
- IF $DATA(^ENG("SP",ENLOC,0))
- SET ENLOC=$PIECE(^(0),U)
- +8 WRITE !!,DA,?15,$EXTRACT(ENMEN,1,60),!,?5,"Man: ",$EXTRACT(ENMAN,1,30),?40,"Cat: ",$EXTRACT(ENCAT,1,35)
- +9 WRITE !,?5,"Model: ",$EXTRACT(ENMOD,1,28),?40,"S/N: ",$EXTRACT(ENSN,1,35),!,?5,"Servc: ",$EXTRACT(ENSER,1,28),?40,"Status: ",$PIECE(ENUSE,":",2),!,?5,"Location: ",$EXTRACT(ENLOC,1,25),?40,"PM#: ",ENPMN
- +10 SET ENEQY=ENEQY+6
- KILL EN
- +11 if $ORDER(^DIC(6910,1,2,0))]""
- DO LOC1^ENLBL16
- +12 QUIT
- CHDR if ENEQPG
- WRITE @ENEQIOF
- SET ENEQPG=ENEQPG+1
- WRITE "COMPANION LISTING (Bar Code Labels)",?ENHDMRGN,"Page ",ENEQPG
- +1 WRITE !,ENEQBY
- if $LENGTH(ENEQBY)<41
- WRITE " (",$SELECT(ENEQUSER]"":$EXTRACT(ENEQUSER,1,20),1:"User unknown"),")"
- WRITE ?ENHDMRGN,ENEQDATE,!,"Equip ID",?15,"* Description *"
- +2 SET X=""
- SET $PIECE(X,"-",80)="-"
- WRITE !,X
- +3 SET ENEQY=0
- +4 QUIT
- HLP WRITE !!,"A 'companion listing' is simply a printout on regular paper (must be at",!,"least 80 columns wide) that is intended for use in the initial application"
- +1 WRITE !,"of the actual bar code labels to individual equipment items. The companion",!,"listing will contain more descriptive information than can be printed"
- +2 WRITE !,"on the labels themselves, and will be sorted in the same order as the",!,"labels."
- +3 QUIT
- OPEN ;
- +1 SET IOP=ENEQION
- DO ^%ZIS
- KILL IOP
- +2 ;HD308658
- SET ENEQIO=IO
- +3 QUIT
- ERR WRITE !,*7,"Device selection unsuccessful.",!
- +1 QUIT
- +2 ;ENLBL9