ACRFIRS7.m

ACRFIRS7 ;IHS/OIRM/DSD/AEF - PRINT VENDOR LABELS [ 11/01/2001   9:44 AM ]

 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001

 ;

EN ;EP -- MAIN ENTRY POINT

 ;

 N ACRHOW,ACRVEN,ACRADD,ACRLPR,ACRROW,ACROUT

 D ^XBKVAR

 D HOME^%ZIS

 D HOW(.ACRHOW)

 Q:$G(ACRHOW)']""

 I ACRHOW="R" D RANGE(.ACRHOW,.ACROUT)

 Q:$G(ACROUT)

 I ACRHOW="I" D INDIV(.ACRVEN,.ACROUT)

 Q:$G(ACROUT)

 D ADD(.ACRADD)

 Q:$G(ACRADD)']""

 D LPR(.ACRLPR)

 Q:'$G(ACRLPR)

 D ROW(.ACRROW)

 Q:'$G(ACRROW)

 S ZTSAVE("ACRHOW")=""

 S ZTSAVE(".ACRVEN")=""

 S ZTSAVE("ACRADD")=""

 S ZTSAVE("ACRLPR")=""

 S ZTSAVE("ACRROW")=""

 D QUE^ACRFUTL("DQ^ACRFIRS7",.ZTSAVE,"PRINT VENDOR LABELS")

 Q

HOW(ACRHOW)        ;

 ;----- ASK INDIVIDUAL VENDORS OR RANGE OF VENDORS

 ;

 N DIR,DIRUT,DTOUT,DUOUT,X,Y

 S DIR(0)="S^I:INDIVIDUAL VENDORS;R:RANGE OF VENDORS"

 D ^DIR

 Q:$D(DTOUT)!($D(DIRUT))!($D(DUOUT))

 Q:Y']""

 S ACRHOW=Y

 Q

RANGE(ACRHOW,ACROUT)         ;

 ;----- ASK VENDOR RANGE

 ;

 N ACRF,ACRL,DIR,DIRUT,DTOUT,DUOUT,X,Y

 S DIR(0)="F^1:30"

 S DIR("A")="Start with Vendor"

 S DIR("B")="FIRST"

 D ^DIR

 I $D(DTOUT)!($D(DIRUT))!($D(DUOUT)) S ACROUT=1 Q

 I Y']"" S ACROUT=1 Q

 S ACRF=Y

 S DIR("A")="Go to Vendor"

 S DIR("B")="LAST"

 D ^DIR

 I $D(DTOUT)!($D(DIRUT))!($D(DUOUT)) S ACROUT=1 Q

 I Y']"" S ACROUT=1 Q

 S ACRL=Y

 S ACRHOW=ACRHOW_U_ACRF_U_ACRL

 Q

INDIV(ACRVEN,ACROUT)         ;

 ;----- ASK FOR INDIVIDUAL VENDORS

 ;

 ;      RETURNS SELECTED VENDORS IN ACRVEN(IEN) ARRAY

 ;

 N ACRQUIT,DIC,DTOUT,DUOUT,X,Y

 K ACRVEN

 S DIC("A")="Select VENDOR: "

 F  D  Q:$G(ACRQUIT)

 . S DIC="^AUTTVNDR("

 . S DIC(0)="AEMQ"

 . D ^DIC

 . I $D(DTOUT)!($D(DUOUT)) S ACRQUIT=1 Q

 . I +Y'>0 S ACRQUIT=1 Q

 . S ACRVEN($P(^AUTTVNDR(+Y,0),U))=+Y

 . S DIC("A")="Select another VENDOR: "

 I '$D(ACRVEN) S ACROUT=1

 Q

ADD(ACRADD)        ;

 ;----- ASK WHICH ADDRESS TO USE

 ;

 N DIR,DIRUT,DTOUT,DUOUT,X,Y

 S DIR(0)="S^M:MAILING ADDRESS;B:BILLING ADDRESS"

 S DIR("A")="Use MAILING ADDRESS or BILLING ADDRESS"

 S DIR("B")="M"

 D ^DIR

 Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))

 Q:Y']""

 S ACRADD=Y

 Q

LPR(ACRLPR)        ;

 ;----- ASK HOW MANY LABELS PER ROW

 ;

 N DIR,DIRUT,DTOUT,DUOUT,X,Y

 S DIR(0)="S^1:ONE VENDOR/ROW, 1 LBL/ROW;2:ONE VENDOR/ROW, 2 LBLS/ROW;3:ONE VENDOR/ROW, 3 LBLS/ROW;4:ONE VENDOR/ROW, 4 LBLS/ROW"

 S DIR("A")="Print Quantity"

 S DIR("B")=1

 D ^DIR

 Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))

 Q:'Y

 S ACRLPR=Y

 Q

ROW(ACRROW)        ;

 ;----- ASK HOW MANY ROWS PER VENDOR

 ;

 N DIR,DIRUT,DTOUT,DUOUT,X,Y

 S DIR(0)="N^1:999"

 S DIR("A")="How many ROWS (No matter how many labels per row)"

 D ^DIR

 Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))

 Q:'Y

 S ACRROW=+Y

 Q

DQ ;EP -- QUEUED JOB STARTS HERE

 ;

 D PRT(ACRHOW,.ACRVEN,ACRADD,ACRLPR,ACRROW)

 K ACRHOW,ACRVEN,ACRADD,ACRLPR,ACRROW

 D ^%ZISC

 Q

PRT(ACRHOW,ACRVEN,ACRADD,ACRLPR,ACRROW)          ;

 ;----- PRINT THE LABELS

 ;

 I $E(ACRHOW)="R" D BLOCK(ACRHOW,ACRADD,ACRLPR,ACRROW)

 I $E(ACRHOW)="I" D EACH(.ACRVEN,ACRADD,ACRLPR,ACRROW)

 Q

BLOCK(ACRHOW,ACRADD,ACRLPR,ACRROW)     ;

 ;----- PRINTS RANGE (BLOCK) OF VENDORS

 ;

 N ACRF,ACRL

 S ACRF=$P(ACRHOW,U,2)

 I ACRF="FIRST" S ACRF=""

 I ACRF]"" S ACRF=$O(^AUTTVNDR("B",ACRF),-1)

 S ACRL=$P(ACRHOW,U,3)

 I ACRL="LAST" S ACRL=$O(^AUTTVNDR("B",""),-1)

 F  S ACRF=$O(^AUTTVNDR("B",ACRF)) Q:ACRF']""  Q:ACRF]ACRL  D

 . S ACRVEN=0

 . F  S ACRVEN=$O(^AUTTVNDR("B",ACRF,ACRVEN)) Q:'ACRVEN  D

 . . D ONE(ACRVEN,ACRLPR,ACRROW,ACRADD)

 Q

EACH(ACRVEN,ACRADD,ACRLPR,ACRROW)      ;

 ;----- PRINTS INDIVIDUAL VENDORS

 ;

 N X

 Q:'$D(ACRVEN)

 S X=""

 F  S X=$O(ACRVEN(X)) Q:X']""  D

 . S ACRVEN=ACRVEN(X)

 . D ONE(ACRVEN,ACRLPR,ACRROW,ACRADD)

 Q

ONE(ACRVEN,ACRLPR,ACRROW,ACRADD)       ;

 ;----- PRINT LABEL(S) FOR ONE VENDOR

 ;

 N I

 F I=1:1:ACRROW D  W !!!

 . D NAME(ACRVEN,ACRLPR)

 . D STR(ACRVEN,ACRLPR,ACRADD)

 . D CITY(ACRVEN,ACRLPR,ACRADD)

 Q

NAME(ACRVEN,ACRLPR)          ;

 ;----- PRINT VENDOR NAME

 ;

 N X

 S X=$P($G(^AUTTVNDR(ACRVEN,0)),U)

 W !,X

 I ACRLPR>1 W ?32,X

 I ACRLPR>2 W ?64,X

 I ACRLPR>3 W ?96,X

 Q

STR(ACRVEN,ACRLPR,ACRADD)    ;

 ;----- PRINT STREET ADDRESS

 ;

 N X

 S X=$G(^AUTTVNDR(ACRVEN,13))

 I ACRADD="M" S X=$P(X,U,1)

 I ACRADD="B" S X=$P(X,U,6)

 W !,X

 I ACRLPR>1 W ?32,X

 I ACRLPR>2 W ?65,X

 I ACRLPR>3 W ?96,X

 Q

CITY(ACRVEN,ACRLPR,ACRADD)   ;

 ;----- PRINT CITY, STATE, ZIP

 ;

 N X

 S X=$G(^AUTTVNDR(ACRVEN,13))

 I ACRADD="M" S X=$P(X,U,2)_", "_$$STATE($P(X,U,3))_"  "_$P(X,U,4)

 I ACRADD="B" S X=$P(X,U,7)_", "_$$STATE($P(X,U,8))_"  "_$P(X,U,9)

 W !,X

 I ACRLPR>1 W ?32,X

 I ACRLPR>2 W ?65,X

 I ACRLPR>3 W ?96,X

 Q

STATE(X) ;----- RETURNS STATE ABBREVIATION

 ;

 S Y=""

 I X']"" Q Y

 S Y=$P($G(^DIC(5,X,0)),U,2)

 Q Y

ACRFIRS7  ;IHS/OIRM/DSD/AEF - PRINT VENDOR LABELS [ 11/01/2001   9:44 AM ]

 +1       ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001

 +2       ;

EN        ;EP -- MAIN ENTRY POINT

 +1       ;

 +2        NEW ACRHOW,ACRVEN,ACRADD,ACRLPR,ACRROW,ACROUT

 +3        DO ^XBKVAR

 +4        DO HOME^%ZIS

 +5        DO HOW(.ACRHOW)

 +6        IF $GET(ACRHOW)']""

               QUIT 

 +7        IF ACRHOW="R"

               DO RANGE(.ACRHOW,.ACROUT)

 +8        IF $GET(ACROUT)

               QUIT 

 +9        IF ACRHOW="I"

               DO INDIV(.ACRVEN,.ACROUT)

 +10       IF $GET(ACROUT)

               QUIT 

 +11       DO ADD(.ACRADD)

 +12       IF $GET(ACRADD)']""

               QUIT 

 +13       DO LPR(.ACRLPR)

 +14       IF '$GET(ACRLPR)

               QUIT 

 +15       DO ROW(.ACRROW)

 +16       IF '$GET(ACRROW)

               QUIT 

 +17       SET ZTSAVE("ACRHOW")=""

 +18       SET ZTSAVE(".ACRVEN")=""

 +19       SET ZTSAVE("ACRADD")=""

 +20       SET ZTSAVE("ACRLPR")=""

 +21       SET ZTSAVE("ACRROW")=""

 +22       DO QUE^ACRFUTL("DQ^ACRFIRS7",.ZTSAVE,"PRINT VENDOR LABELS")

 +23       QUIT 

HOW(ACRHOW) ;

 +1       ;----- ASK INDIVIDUAL VENDORS OR RANGE OF VENDORS

 +2       ;

 +3        NEW DIR,DIRUT,DTOUT,DUOUT,X,Y

 +4        SET DIR(0)="S^I:INDIVIDUAL VENDORS;R:RANGE OF VENDORS"

 +5        DO ^DIR

 +6        IF $DATA(DTOUT)!($DATA(DIRUT))!($DATA(DUOUT))

               QUIT 

 +7        IF Y']""

               QUIT 

 +8        SET ACRHOW=Y

 +9        QUIT 

RANGE(ACRHOW,ACROUT) ;

 +1       ;----- ASK VENDOR RANGE

 +2       ;

 +3        NEW ACRF,ACRL,DIR,DIRUT,DTOUT,DUOUT,X,Y

 +4        SET DIR(0)="F^1:30"

 +5        SET DIR("A")="Start with Vendor"

 +6        SET DIR("B")="FIRST"

 +7        DO ^DIR

 +8        IF $DATA(DTOUT)!($DATA(DIRUT))!($DATA(DUOUT))

               SET ACROUT=1

               QUIT 

 +9        IF Y']""

               SET ACROUT=1

               QUIT 

 +10       SET ACRF=Y

 +11       SET DIR("A")="Go to Vendor"

 +12       SET DIR("B")="LAST"

 +13       DO ^DIR

 +14       IF $DATA(DTOUT)!($DATA(DIRUT))!($DATA(DUOUT))

               SET ACROUT=1

               QUIT 

 +15       IF Y']""

               SET ACROUT=1

               QUIT 

 +16       SET ACRL=Y

 +17       SET ACRHOW=ACRHOW_U_ACRF_U_ACRL

 +18       QUIT 

INDIV(ACRVEN,ACROUT) ;

 +1       ;----- ASK FOR INDIVIDUAL VENDORS

 +2       ;

 +3       ;      RETURNS SELECTED VENDORS IN ACRVEN(IEN) ARRAY

 +4       ;

 +5        NEW ACRQUIT,DIC,DTOUT,DUOUT,X,Y

 +6        KILL ACRVEN

 +7        SET DIC("A")="Select VENDOR: "

 +8        FOR 

               Begin DoDot:1

 +9                SET DIC="^AUTTVNDR("

 +10               SET DIC(0)="AEMQ"

 +11               DO ^DIC

 +12               IF $DATA(DTOUT)!($DATA(DUOUT))

                       SET ACRQUIT=1

                       QUIT 

 +13               IF +Y'>0

                       SET ACRQUIT=1

                       QUIT 

 +14               SET ACRVEN($PIECE(^AUTTVNDR(+Y,0),U))=+Y

 +15               SET DIC("A")="Select another VENDOR: "

               End DoDot:1

               IF $GET(ACRQUIT)

                   QUIT 

 +16       IF '$DATA(ACRVEN)

               SET ACROUT=1

 +17       QUIT 

ADD(ACRADD) ;

 +1       ;----- ASK WHICH ADDRESS TO USE

 +2       ;

 +3        NEW DIR,DIRUT,DTOUT,DUOUT,X,Y

 +4        SET DIR(0)="S^M:MAILING ADDRESS;B:BILLING ADDRESS"

 +5        SET DIR("A")="Use MAILING ADDRESS or BILLING ADDRESS"

 +6        SET DIR("B")="M"

 +7        DO ^DIR

 +8        IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))

               QUIT 

 +9        IF Y']""

               QUIT 

 +10       SET ACRADD=Y

 +11       QUIT 

LPR(ACRLPR) ;

 +1       ;----- ASK HOW MANY LABELS PER ROW

 +2       ;

 +3        NEW DIR,DIRUT,DTOUT,DUOUT,X,Y

 +4        SET DIR(0)="S^1:ONE VENDOR/ROW, 1 LBL/ROW;2:ONE VENDOR/ROW, 2 LBLS/ROW;3:ONE VENDOR/ROW, 3 LBLS/ROW;4:ONE VENDOR/ROW, 4 LBLS/ROW"

 +5        SET DIR("A")="Print Quantity"

 +6        SET DIR("B")=1

 +7        DO ^DIR

 +8        IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))

               QUIT 

 +9        IF 'Y

               QUIT 

 +10       SET ACRLPR=Y

 +11       QUIT 

ROW(ACRROW) ;

 +1       ;----- ASK HOW MANY ROWS PER VENDOR

 +2       ;

 +3        NEW DIR,DIRUT,DTOUT,DUOUT,X,Y

 +4        SET DIR(0)="N^1:999"

 +5        SET DIR("A")="How many ROWS (No matter how many labels per row)"

 +6        DO ^DIR

 +7        IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))

               QUIT 

 +8        IF 'Y

               QUIT 

 +9        SET ACRROW=+Y

 +10       QUIT 

DQ        ;EP -- QUEUED JOB STARTS HERE

 +1       ;

 +2        DO PRT(ACRHOW,.ACRVEN,ACRADD,ACRLPR,ACRROW)

 +3        KILL ACRHOW,ACRVEN,ACRADD,ACRLPR,ACRROW

 +4        DO ^%ZISC

 +5        QUIT 

PRT(ACRHOW,ACRVEN,ACRADD,ACRLPR,ACRROW) ;

 +1       ;----- PRINT THE LABELS

 +2       ;

 +3        IF $EXTRACT(ACRHOW)="R"

               DO BLOCK(ACRHOW,ACRADD,ACRLPR,ACRROW)

 +4        IF $EXTRACT(ACRHOW)="I"

               DO EACH(.ACRVEN,ACRADD,ACRLPR,ACRROW)

 +5        QUIT 

BLOCK(ACRHOW,ACRADD,ACRLPR,ACRROW) ;

 +1       ;----- PRINTS RANGE (BLOCK) OF VENDORS

 +2       ;

 +3        NEW ACRF,ACRL

 +4        SET ACRF=$PIECE(ACRHOW,U,2)

 +5        IF ACRF="FIRST"

               SET ACRF=""

 +6        IF ACRF]""

               SET ACRF=$ORDER(^AUTTVNDR("B",ACRF),-1)

 +7        SET ACRL=$PIECE(ACRHOW,U,3)

 +8        IF ACRL="LAST"

               SET ACRL=$ORDER(^AUTTVNDR("B",""),-1)

 +9        FOR 

               SET ACRF=$ORDER(^AUTTVNDR("B",ACRF))

               IF ACRF']""

                   QUIT 

               IF ACRF]ACRL

                   QUIT 

               Begin DoDot:1

 +10               SET ACRVEN=0

 +11               FOR 

                       SET ACRVEN=$ORDER(^AUTTVNDR("B",ACRF,ACRVEN))

                       IF 'ACRVEN

                           QUIT 

                       Begin DoDot:2

 +12                       DO ONE(ACRVEN,ACRLPR,ACRROW,ACRADD)

                       End DoDot:2

               End DoDot:1

 +13       QUIT 

EACH(ACRVEN,ACRADD,ACRLPR,ACRROW) ;

 +1       ;----- PRINTS INDIVIDUAL VENDORS

 +2       ;

 +3        NEW X

 +4        IF '$DATA(ACRVEN)

               QUIT 

 +5        SET X=""

 +6        FOR 

               SET X=$ORDER(ACRVEN(X))

               IF X']""

                   QUIT 

               Begin DoDot:1

 +7                SET ACRVEN=ACRVEN(X)

 +8                DO ONE(ACRVEN,ACRLPR,ACRROW,ACRADD)

               End DoDot:1

 +9        QUIT 

ONE(ACRVEN,ACRLPR,ACRROW,ACRADD) ;

 +1       ;----- PRINT LABEL(S) FOR ONE VENDOR

 +2       ;

 +3        NEW I

 +4        FOR I=1:1:ACRROW

               Begin DoDot:1

 +5                DO NAME(ACRVEN,ACRLPR)

 +6                DO STR(ACRVEN,ACRLPR,ACRADD)

 +7                DO CITY(ACRVEN,ACRLPR,ACRADD)

               End DoDot:1

               WRITE !!!

 +8        QUIT 

NAME(ACRVEN,ACRLPR) ;

 +1       ;----- PRINT VENDOR NAME

 +2       ;

 +3        NEW X

 +4        SET X=$PIECE($GET(^AUTTVNDR(ACRVEN,0)),U)

 +5        WRITE !,X

 +6        IF ACRLPR>1

               WRITE ?32,X

 +7        IF ACRLPR>2

               WRITE ?64,X

 +8        IF ACRLPR>3

               WRITE ?96,X

 +9        QUIT 

STR(ACRVEN,ACRLPR,ACRADD) ;

 +1       ;----- PRINT STREET ADDRESS

 +2       ;

 +3        NEW X

 +4        SET X=$GET(^AUTTVNDR(ACRVEN,13))

 +5        IF ACRADD="M"

               SET X=$PIECE(X,U,1)

 +6        IF ACRADD="B"

               SET X=$PIECE(X,U,6)

 +7        WRITE !,X

 +8        IF ACRLPR>1

               WRITE ?32,X

 +9        IF ACRLPR>2

               WRITE ?65,X

 +10       IF ACRLPR>3

               WRITE ?96,X

 +11       QUIT 

CITY(ACRVEN,ACRLPR,ACRADD) ;

 +1       ;----- PRINT CITY, STATE, ZIP

 +2       ;

 +3        NEW X

 +4        SET X=$GET(^AUTTVNDR(ACRVEN,13))

 +5        IF ACRADD="M"

               SET X=$PIECE(X,U,2)_", "_$$STATE($PIECE(X,U,3))_"  "_$PIECE(X,U,4)

 +6        IF ACRADD="B"

               SET X=$PIECE(X,U,7)_", "_$$STATE($PIECE(X,U,8))_"  "_$PIECE(X,U,9)

 +7        WRITE !,X

 +8        IF ACRLPR>1

               WRITE ?32,X

 +9        IF ACRLPR>2

               WRITE ?65,X

 +10       IF ACRLPR>3

               WRITE ?96,X

 +11       QUIT 

STATE(X)  ;----- RETURNS STATE ABBREVIATION

 +1       ;

 +2        SET Y=""

 +3        IF X']""

               QUIT Y

 +4        SET Y=$PIECE($GET(^DIC(5,X,0)),U,2)

 +5        QUIT Y