source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVGGG3.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1ABSVGGG3 ;VAMC ALTOONA/CTB - GENERIC LABEL PRINTING ROUTINE;5/18/00 3:56 PM ;1/12/01 8:04 PM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**7,10,15,22,23**;JULY 1994;
3 ;GIVEN LIST OF RECORDS IN ^TMP($J,"VLABEL",N)=DA
4 ;PRINT MULTI COLUMN LABEL
5 ;NLABEL=NUMBER OF LABELS/ROW
6 ;NLINES=NUMBER OF LINES/LABEL
7 ;NPAGE=NUMBER OF LABELS/PAGE
8 S NLINES=6
9 ;DIC=GLOBAL REFERENCE OF FILE
10 ;DR=FIELD NUMBERS TO BE INCLUDED IN LABEL
11 ;print volunteer labels by name
12 K ^TMP("VLABEL")
13 N COUNT,ABSVX,B,DIJ,DIPASS,DISYS,DP,IOP,NODE,P,POP,TYPE,X,ABSVTERM,LASER
14 S ABSVTERM=IO
15 S DIC=503338.1,DIC(0)="AQEMNZ",DIC("A")="Select Label Type: " D ^DIC
16 I Y<0 S X=" Cannot proceed without type of label. Option terminated." D MSG^ABSVQ QUIT
17 S PARAMS=Y(0),LASER=$P(PARAMS,"^",9)
18 S X=($P(PARAMS,"^",2)*$P(PARAMS,"^",3))-1
19 S:X<0 X=0
20 S $P(PARAMS,"^",10)=0
21 I $P(PARAMS,"^",2)>1 D
22 . S DIR(0)="NA^0:"_X_":0",DIR("A")="Skip used labels of first page: ",DIR("B")=0,DIR("?")="Enter the number of labels on the first page that have already been used."
23 . D ^DIR K DIR
24 . Q:Y["^" S $P(PARAMS,"^",10)=Y
25 . QUIT
26 S %ZIS("A")="Please Select Label Device: ",%ZIS="QD" D ^%ZIS I POP D HOME^%ZIS QUIT
27 I 'LASER D ALIGN^ABSVLBL I '% S IOP=ION D ^%ZISC
28 I $D(IO("Q")) D I '$D(DQTIME) S X=" <Option Terminated>*" D MSG^ABSVQ QUIT
29 . K DQTIME,%DT
30 . S %DT="AER",%DT("A")="Select Date/Time to Print: ",%DT("B")="NOW" D ^%DT
31 . Q:Y<0
32 . S DQTIME=X
33 . QUIT
34 S DIR(0)="SO^1:FACILITY;2:STATE;3:VISN;4:ALL"
35 S DIR("L",1)=" Sort Labels By: "
36 S DIR("L",2)=" "
37 S DIR("L",3)=" 1 FACILITY 2 STATE"
38 S DIR("L")=" 3 VISN 4 ALL"
39 S DIR("?")="Enter a code from the list"
40 D ^DIR K DIR
41 I $$DIR^ABSVU2 QUIT
42 S TYPE=+Y D @TYPE Q:'$D(BY)
43 S IOP=$S($D(IO("Q")):"Q;",1:"")_ION D ^%ZISC
44DQ S DIC=503339.2,L=0,FLDS="" S DHIT="S COUNT=$G(COUNT)+1,^TMP($J,""VLABEL"",COUNT)=D0",DHD="@@"
45 S DIOBEG="W ! K ^TMP($J,""VLABEL""),^TMP($J,""XVLABEL"")",DIOEND="D LABEL^ABSVLBL2(LABELDIC,LABELDR,PARAMS)"
46 S LABELDIC=DIC,LABELDR="3;4;4.5;22"
47 D EN1^DIP
48 K COL,PARAMS,OFFSET,LABELDIC,LABELDR,NCOL,NEXT,NLABEL,NLINES,NNPAGE,NPAGE,ABSV("INST"),ABSV("SITE"),ABSV("SITENAME"),ABSV("PARAM"),ABSV("PER")
49 QUIT
501 K DIC
51 S DIC=503339.2,DIC(0)="AEMNZQ",DIC("A")="Select Primary Station Number: " D ^DIC
52 I Y<0 D NO QUIT
53 S BY=.01,(FR,TO)=$P(Y,"^",2)
54 QUIT
552 K DIC
56 S DIC=5,DIC(0)="AEMNZQ" D ^DIC
57 I Y<0 D NO QUIT
58 S BY=6,(FR,TO)=$P(Y,"^",2)
59 QUIT
603 K DIR
61 S DIR(0)="NA^1:22:0",DIR("A")="Select VISN Number: "
62 D ^DIR
63 K DIR
64 I $$DIR^ABSVU2 QUIT
65 S BY=2,(FR,TO)=+Y
66 QUIT
674 S BY=1,FR="A",TO="ZZZ"
68 QUIT
69NO S X="No Selection Made, Option Terminating!*" D MSG^ABSVQ
70 QUIT
Note: See TracBrowser for help on using the repository browser.