source: FOIAVistA/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVTPR.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 5.9 KB
Line 
1ABSVTPR ;VAMC ALTOONA/CTB_CLH - MISC REPORT PROGRAM ;4/22/99 3:11 PM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**3,6,7,10,15**;JULY 6, 1994
3OUT K %DT,%,%X,B,ABSVX("CREATE"),ABSVX("BDATE"),ABSVX("EDATE"),BDATE,COMB,DA,DA1,DDH,DIC,DIE,DIJ,DIK,DP,DQ,DR,DUOUT,EDATE,MONTH,NN,NAME,ORG,SER,VOL,TC,TC1,TC2,TC3,VOLDA,X,X1,XZ,Y,ZI
4 Q
5DAREVIEW ;REVIEW THE DAILY LIST FOR A SINGLE VOLUNTEER FOR A RANGE OF DATES
6 D ^ABSVSITE Q:'%
7 S DIC("A")="Select VOLUNTEER NAME: "
8DARE1 S DIC=503330,DIC(0)="AMENQ",DIC("S")="I $D(^ABS(503330,+Y,4,ABSV(""INST""),0))"
9 D MDIV^ABSVSITE,^DIC G OUT:Y<0
10 S DA=+Y,VOLDA=+Y I $P(^ABS(503330,DA,4,ABSV("INST"),0),"^",8)]"" S X="<Volunteer has been terminated>*" D MSG^ABSVQ
11 I '$D(^ABS(503331,"B",DA)) W !,"NO ENTRIES IN FILE FOR THIS VOLUNTEER",*7 G OUT
12 D RANGE^ABSVTPR1 G:Y<0 OUT
13 S ZTDESC="DAILY LIST FOR SINGLE VOLUNTEER",ZTRTN="DV^ABSVTPR",ZTSAVE("VOLDA")="",ZTSAVE("ABSV(""SITE"")")="",ZTSAVE("BDATE")="",ZTSAVE("EDATE")="" D ^ABSVQ,OUT
14 S DIC("A")="Select Another VOLUNTEER NAME: " G DARE1
15DV ;
16 I '$D(ZTQUEUED) D WAIT^ABSVYN
17 K ^TMP("ABSVVIEW",$J)
18 S IOP=ABIOP I '$D(ZTQUEUED),'$D(IO("S")) D WAIT^ABSVYN
19 S N=0 F I=1:1 S N=$O(^ABS(503331,"B",VOLDA,N)) Q:'N I $D(^ABS(503331,N,0)) S X=^ABS(503331,N,0) I $P(X,"^",7)=ABSV("SITE"),$P(X,"^",3)'<BDATE,$P(X,"^",3)'>EDATE S ^TMP("ABSVVIEW",$J,N)=""
20 S L=0,DIC="^ABS(503331,",FR="",TO="",BY=".01,2",FLDS="[ABSV REVIEW DAILY ENTRIES]",BY(0)="^TMP(""ABSVVIEW"",$J,",L(0)=1
21 D EN1^DIP
22 K ^TMP("ABSVVIEW",$J)
23 I $D(ZTQUEUED) D KILL^%ZTLOAD
24 G OUT Q
25ORGLIST ;PRINT DETAIL VOLUNTEER HOURS BY ORGANIZATION FROM FILE 503335
26 N B,DINS,Y,DATE
27 D ^ABSVSITE Q:'%
28 S %DT="AE",%DT("A")="Select MONTH/YEAR: " D ^%DT K %DT Q:Y<0
29 S DATE=$E(Y,1,5)_"00"
30 S L=0,DIC="^ABS(503335,",FR=DATE,TO=DATE,(BY,FLDS)="[ABSV ORGANIZATION DETAIL LIST]",DIS(0)="I $P($G(^ABS(503335,D0,0)),U,12)=ABSV(""SITE"")"
31 I $D(ABSV("CONDENSED")) S FLDS="[ABSV ORGANIZATION CONDENSED]"
32 D EN1^DIP,DIKILL^ABSVQ Q
33SERVLIST ;PRINT DETAIL VOLUNTEER HOURS BY SERVICE FROM FILE 503335
34 D ^ABSVSITE Q:'%
35 S L=0,DIC="^ABS(503335,",(FR,TO)="?",DIS(0)="I $P($G(^ABS(503335,D0,0)),U,12)=ABSV(""SITE"")",(BY,FLDS)="[ABSV SERVICE LIST]" D EN1^DIP,DIKILL^ABSVQ,OUT
36 QUIT
37OLIST ;PRINT SUMMARY ORG REPORT
38 D ^ABSVSITE Q:'%
39 S L=0,DIC="^ABS(503335,",(FR,TO)="?",DIS(0)="I $P($G(^ABS(503335,D0,0)),U,12)=ABSV(""SITE"")",(BY,FLDS)="[ABSV ORGANIZATION SUMMARY]" D EN1^DIP,DIKILL^ABSVQ Q
40SLIST ;PRINT SUMMARY SERVICE REPORT
41 D ^ABSVSITE Q:'%
42 S L=0,DIC="^ABS(503335,",(FR,TO)="?",DIS(0)="I $P($G(^ABS(503335,D0,0)),U,12)=ABSV(""SITE"")",(BY,FLDS)="[ABSV SERVICE SUMMARY]" D EN1^DIP,DIKILL^ABSVQ,OUT
43 QUIT
44WEEKLY ;PRINT WEEKLY TIME SUMMARY REPORT
45 D ^ABSVSITE Q:'%
46 S L=0,DIC="^ABS(503331,",(FR,TO)="?",DIS(0)="I $P($G(^ABS(503331,D0,0)),U,7)=ABSV(""SITE"")",(BY,FLDS)="[ABSV WEEKLY WORK SUMMARY]" D EN1^DIP,DIKILL^ABSVQ,OUT
47 QUIT
48SELORG ;PRINT SELECTED ORGANIZATIONS
49 D ^ABSVSITE Q:'%
50 S X="Using this option you may select up to 10 organization to print out per session.*" D MSG^ABSVQ W !
51 S XZ=1,DIC=503334,DIC(0)="AEMNQZ",DIC("A")="Select Organization #1: "
52 F ZI=1:1 Q:XZ>10 D ^DIC Q:+Y<0 W:'$D(^ABS(503335,"AD",+Y)) !,"THERE ARE NO ENTRIES IN THE TIME CARD FILE FOR THIS ORGANIZATION",*7 I $D(^(+Y)) S ABSVX("LIST",+Y)=$P(Y(0),"^",2),XZ=XZ+1,DIC("A")="Select Organization #"_XZ_": "
53 K DIC I $D(ABSVX("LIST"))'>9 S X="No Organizations Selected.*" D MSG^ABSVQ G OUT
54 S BPROMPT="Select Beginning Month/Year: ",EPROMPT="Select Ending Month: ",MONTH=""
55 W ! D RANGE^ABSVTPR1 K MONTH
56 G:Y<0 OUT S ABSVX("EDATE")=EDATE,ABSVX("BDATE")=$E(BDATE,1,5)_"00"
57 S ZTRTN="SO1^ABSVTPR",ZTDESC="VOLUNTARY SELECTED ORGANIZATION LISTING",ZTSAVE("ABSV*")="",ZTSAVE("EDATE")="",ZTSAVE("BDATE")="" D ^ABSVQ D OUT Q
58SO1 ;DQ SELECTED ORG LISTING
59 K ^TMP("ABSVSELORG",$J)
60 I '$D(ZTQUEUED) D WAIT^ABSVYN
61 S DA=0
62 F S DA=$O(ABSVX("LIST",DA)) Q:'DA D
63 . S N=0
64 . F S N=$O(^ABS(503335,"AD",DA,N)) Q:'N D
65 . . S X=^ABS(503335,N,0)
66 . . I $P(X,"^",12)=ABSV("SITE"),$P(X,"^",5)'<BDATE,$P(X,"^",5)'>EDATE S ^TMP("ABSVSELORG",$J,N)=""
67 . . Q
68 . Q
69 K ABSVX("LIST") I '$D(^TMP("ABSVSELORG",$J)) S X="No Time Cards Found.*" D:'$D(ZTQUEUED) MSG^ABSVQ D:$D(ZTQUEUED) KILL^%ZTLOAD G OUT
70 S IOP=ABIOP
71 S L=0,L(0)=1,DIC="^ABS(503335,",BY="#+1.15,+4,NAME",BY(0)="^TMP(""ABSVSELORG"",$J,",(FR,TO)="",FLDS="[ABSV ORGANIZATION DETAIL LIST]"
72 I $D(ABSV("CONDENSED")) S FLDS="[ABSV ORGANIZATION CONDENSED]",BY="#+1.15,+4,NAME"
73 D EN1^DIP,DIKILL^ABSVQ
74 K ^TMP("ABSVSELORG",$J)
75 I $D(ZTQUEUED) D KILL^%ZTLOAD Q
76 QUIT
77CONDENSE ;PRINT SELECTED ORGANIZATION CONDENSED LIST
78 S ABSV("CONDENSED")="" D SELORG
79 K ABSV("CONDENSED") QUIT
80CORG ;PRINT CONDENSED ORGANIZATION REPORT
81 S ABSV("CONDENSED")="" D ORGLIST
82 K ABSV("CONDENSED") QUIT
83CODE ;PRINT LIST OF SIGNIN CODES
84 D ^ABSVSITE Q:'%
85 S DIC=503330,L=0,FLDS="[ABSV SIGN-IN LIST]",BY=".01"
86 S:'$D(DIS(0)) DIS(0)="I $$ACTIVE^ABSVU2(D0,"_ABSV("INST")_",1)"
87 D EN1^DIP
88 D ^%ZISC
89 QUIT
90GAMES ;PRINT MASTER REGISTRATION LIST
91 D ^ABSVSITE Q:'%
92 S DIC=503330,L=0,(BY,FLDS)="[ABSV GAMES MASTER REGISTRATION]",(FR,TO)=",,"_ABSV("SITE")
93 S:'$D(DIS(0)) DIS(0)="I $$ACTIVE^ABSVU2(D0,"_ABSV("INST")_",1)"
94 D EN1^DIP
95 D ^%ZISC
96 QUIT
97SHIRTS ;PRINT SHIRT ISSUE LIST FOR GAMES
98 D ^ABSVSITE Q:'%
99 S DIC=503330,L=0,(BY,FLDS)="[ABSV GAMES SHIRT LIST]"
100 S:'$D(DIS(0)) DIS(0)="I $$ACTIVE^ABSVU2(D0,"_ABSV("INST")_",1)"
101 S DIOBEG="S ABSVLINE=$S(IOM>95:40,1:25)"
102 D EN1^DIP
103 D ^%ZISC K ABSVLINE
104 QUIT
105SIGNIN ;PRINT SIGN-IN ROSTERS
106 D ^ABSVSITE Q:'%
107 S DIC=503330,L=0,(BY,FLDS)="[ABSV GAMES SIGN-IN LIST]"
108 S:'$D(DIS(0)) DIS(0)="I $$ACTIVE^ABSVU2(D0,"_ABSV("INST")_",1)"
109 S DIOBEG="S ABSVLINE=$S(IOM>95:40,1:25)"
110 D EN1^DIP
111 D ^%ZISC K ABSVLINE
112 QUIT
113ASSIGN ;PRINT ASSIGNMENT SCHEDULES
114 D ^ABSVSITE Q:'%
115 S DIC=503330,L=0,(BY,FLDS)="[ABSV GAMES ASSIGNMENT SCHEDULE]",(FR,TO)=ABSV("SITE")_",?,?"
116 S:'$D(DIS(0)) DIS(0)="I $$ACTIVE^ABSVU2(D0,"_ABSV("INST")_",1)"
117 D EN1^DIP
118 D ^%ZISC
119 QUIT
120WORK ;PRINT WORK SCHEDULE
121 D ^ABSVSITE Q:'%
122 S DIC=503330,L=0,(BY,FLDS)="[ABSV GAMES WORK SCHEDULE]",(FR,TO)=ABSV("SITE")_",?,?"
123 S:'$D(DIS(0)) DIS(0)="I $$ACTIVE^ABSVU2(D0,"_ABSV("INST")_",1)"
124 D EN1^DIP
125 D ^%ZISC
126 QUIT
Note: See TracBrowser for help on using the repository browser.