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
