ENLBL2 ;(WASH ISC)/DH-Print Driver for Equipment Labels ;3-26-92
V ;;7.0;ENGINEERING;;Aug 17, 1993
 D:'$D(DT) DT^DICRW S U="^",S=";",O=$T(OPT) I $D(^DOPT($P(O,S,5),"VERSION")),($P($T(V),S,3)=^DOPT($P(O,S,5),"VERSION")) G IN
 K ^DOPT($P(O,S,5))
 F I=1:1 Q:$T(OPT+I)=""  S ^DOPT($P(O,S,5),I,0)=$P($T(OPT+I),S,3),^DOPT($P(O,S,5),"B",$P($P($T(OPT+I),S,3),"^",1),I)=""
 S K=I-1,^DOPT($P(O,S,5),0)=$P(O,S,4)_U_1_U_K_U_K K I,K,X S ^DOPT($P(O,S,5),"VERSION")=$P($T(V),S,3)
IN I $P(O,S,6)'="" D @($P(O,S,6))
PR S O=$T(OPT),S=";" S IOP="HOME" D ^%ZIS W:IOST'["PK-" @IOF K IOP
 D HDR F J=1:1 Q:'$D(^DOPT($P(O,S,5),J,0))  W !,?15,J,". ",$P(^DOPT($P(O,S,5),J,0),U,1)
RE W ! S DIC("A")="Select "_$P($T(OPT),S,4)_": EXIT// ",DIC="^DOPT("_""""_$P($T(OPT),S,5)_""""_",",DIC(0)="AEQMN" D ^DIC G:X=""!(X=U) EXIT G:Y<0 RE K DIC,J,O D @($P($T(OPT+Y),S,4)) G PR
HDR W @IOF,!!,"EQUIPMENT LABEL MODULE",!,$P($T(V),S,3),! Q
INIT S:'$D(DTIME) DTIME=600 S ENERR=0,IOP="HOME",U="^" D ^%ZIS K IOP Q
EXIT K DIC,ENERR,I,J,K,O,S,X,Y
OPT ;;EQUIPMENT LABEL MODULE;EQUIPMENT LABEL PRINTING MENU;ENEQLBL2
 ;;COMPLETE CMR;CMR^ENLBL5
 ;;EQUIPMENT CATEGORY;CAT^ENLBL3
 ;;RANGE OF PM NUMBERS;PM^ENLBL10
 ;;GENERAL LOCATION (WING);WING^ENLBL6
 ;;SPECIFIC LOCATION (ROOM);RM^ENLBL6
 ;;SINGLE PIECE OF EQUIPMENT;SD^ENLBL3
 ;;BY EQUIPMENT ID#;ALL^ENLBL5
 ;;PM WORKLIST;WRKLST^ENLBL11
 ;;PURCHASE ORDER #;PO^ENLBL12
 ;;LOCAL IDENTIFIER;LOCID^ENLBL15
 ;;OWNING SERVICE;SRVC^ENLBL12
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENLBL2   1461     printed  Sep 23, 2025@19:30:20                                                                                                                                                                                                      Page 2
ENLBL2    ;(WASH ISC)/DH-Print Driver for Equipment Labels ;3-26-92
V         ;;7.0;ENGINEERING;;Aug 17, 1993
 +1        if '$DATA(DT)
               DO DT^DICRW
           SET U="^"
           SET S=";"
           SET O=$TEXT(OPT)
           IF $DATA(^DOPT($PIECE(O,S,5),"VERSION"))
               IF ($PIECE($TEXT(V),S,3)=^DOPT($PIECE(O,S,5),"VERSION"))
                   GOTO IN
 +2        KILL ^DOPT($PIECE(O,S,5))
 +3        FOR I=1:1
               if $TEXT(OPT+I)=""
                   QUIT 
               SET ^DOPT($PIECE(O,S,5),I,0)=$PIECE($TEXT(OPT+I),S,3)
               SET ^DOPT($PIECE(O,S,5),"B",$PIECE($PIECE($TEXT(OPT+I),S,3),"^",1),I)=""
 +4        SET K=I-1
           SET ^DOPT($PIECE(O,S,5),0)=$PIECE(O,S,4)_U_1_U_K_U_K
           KILL I,K,X
           SET ^DOPT($PIECE(O,S,5),"VERSION")=$PIECE($TEXT(V),S,3)
IN         IF $PIECE(O,S,6)'=""
               DO @($PIECE(O,S,6))
PR         SET O=$TEXT(OPT)
           SET S=";"
           SET IOP="HOME"
           DO ^%ZIS
           if IOST'["PK-"
               WRITE @IOF
           KILL IOP
 +1        DO HDR
           FOR J=1:1
               if '$DATA(^DOPT($PIECE(O,S,5),J,0))
                   QUIT 
               WRITE !,?15,J,". ",$PIECE(^DOPT($PIECE(O,S,5),J,0),U,1)
RE         WRITE !
           SET DIC("A")="Select "_$PIECE($TEXT(OPT),S,4)_": EXIT// "
           SET DIC="^DOPT("_""""_$PIECE($TEXT(OPT),S,5)_""""_","
           SET DIC(0)="AEQMN"
           DO ^DIC
           if X=""!(X=U)
               GOTO EXIT
           if Y<0
               GOTO RE
           KILL DIC,J,O
           DO @($PIECE($TEXT(OPT+Y),S,4))
           GOTO PR
HDR        WRITE @IOF,!!,"EQUIPMENT LABEL MODULE",!,$PIECE($TEXT(V),S,3),!
           QUIT 
INIT       if '$DATA(DTIME)
               SET DTIME=600
           SET ENERR=0
           SET IOP="HOME"
           SET U="^"
           DO ^%ZIS
           KILL IOP
           QUIT 
EXIT       KILL DIC,ENERR,I,J,K,O,S,X,Y
OPT       ;;EQUIPMENT LABEL MODULE;EQUIPMENT LABEL PRINTING MENU;ENEQLBL2
 +1       ;;COMPLETE CMR;CMR^ENLBL5
 +2       ;;EQUIPMENT CATEGORY;CAT^ENLBL3
 +3       ;;RANGE OF PM NUMBERS;PM^ENLBL10
 +4       ;;GENERAL LOCATION (WING);WING^ENLBL6
 +5       ;;SPECIFIC LOCATION (ROOM);RM^ENLBL6
 +6       ;;SINGLE PIECE OF EQUIPMENT;SD^ENLBL3
 +7       ;;BY EQUIPMENT ID#;ALL^ENLBL5
 +8       ;;PM WORKLIST;WRKLST^ENLBL11
 +9       ;;PURCHASE ORDER #;PO^ENLBL12
 +10      ;;LOCAL IDENTIFIER;LOCID^ENLBL15
 +11      ;;OWNING SERVICE;SRVC^ENLBL12