source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVTPR1.m@ 1133

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

initial load of WorldVistAEHR
File size: 4.6 KB
Line 
1ABSVTPR1 ;VAMC ALTOONA/CTB - MISC REPORTS MENU ;5/22/97 10:58 AM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**3,6,7**;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
5RANGE ;ENTER RANGE OF DATES
6 S DIR(0)="DA^2800101:3500101:E",DIR("A")=$S($D(BPROMPT):BPROMPT,1:"Select Beginning Date: ")
7 D ^DIR K DIR,BPROMPT
8 I $$DIR^ABSVU2 S Y=-1 Q
9 S BDATE=$S($D(MONTH):$E(Y,1,5)_"00",1:Y)
10 S DIR(0)="DA^"_BDATE_":3500101:E",DIR("A")=$S($D(EPROMPT):EPROMPT,1:"Select Ending Date: "),DIR("B")=$$FULLDAT^ABSVU2(BDATE)
11 D ^DIR K DIR,EPROMPT
12 I $S($D(DTOUT):1,$D(DUOUT):1,$D(DIRUT):1,$D(DIROUT):1,1:0) K DTOUT,DUOUT,DIRUT,DIROUT S Y=-1 Q
13 S EDATE=$S($D(MONTH):$$EOM(Y),1:Y)
14 I $D(FULLDAT) S EDATE=EDATE_"^"_$$FULLDAT^ABSVU2(EDATE),BDATE=BDATE_"^"_$$FULLDAT^ABSVU2(BDATE) K FULLDAT
15 K DIR,MONTH Q
16EOM(X) N MO,DAY,YR
17 S YR=$E(X,1,3)+1700,MO=$E(X,4,5)
18 I "01,03,05,07,08,10,12"[MO Q $E(X,1,5)_31
19 I "04,06,09,11"[MO Q $E(X,1,5)_30
20 I X<1,X>12 Q X
21 I YR#4 Q $E(X,1,5)_28
22 Q $E(X,1,5)_29
23WEEKLY ;PRINT WEEKLY TIME SUMMARY REPORT
24 D ^ABSVSITE Q:'%
25 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
26 QUIT
27TELLIST ;PRINT TELEPHONE LIST OF VOLUNTEERS
28 NEW TYPE
29 D ^ABSVSITE Q:'%
30 S DIR(0)="S^1:ACTIVE VOLUNTEERS;2:TERMINATED VOLUNTEERS",DIR("A")="Select Telephone List Type"
31 S DIR("?")="Select Printout Type. You may enter an '^' to quit."
32 D ^DIR
33 K DIR
34 I $$DIR^ABSVU2 QUIT
35 S TYPE=+Y
36 S L=0,DIC="^ABS(503330,",BY=.01,FR="A",TO="zzzz",FLDS=".01;L35,16.9;L20,1;L12"
37 D @TYPE
38 D EN1^DIP,DIKILL^ABSVQ,OUT
39 QUIT
401 ;PRINT LIST OF ACTIVE VOLUNTEERS
41 S DIS(0)="I $D(^ABS(503330,D0,4,"_ABSV("INST")_",0)),$P(^(0),U,8)=""""",DHD="VOLUNTEER TELEPHONE LIST - ACTIVE - "_ABSV("SITENAME")
42 QUIT
432 ;PRINT LIST OF TERMINATED VOLUNTEERS
44 S DIS(0)="I $D(^ABS(503330,D0,4,"_ABSV("INST")_",0)),$P(^(0),U,8)]""""",DHD="VOLUNTEER TELEPHONE LIST - TERMINATED - "_ABSV("SITENAME")
45 QUIT
46SELSER ;PRINT SELECTED SERVICES
47 D ^ABSVSITE Q:'%
48 S X="Using this option you may select up to 10 services to print out per session.*" D MSG^ABSVQ W !
49 S XZ=1,DIC=503332,DIC(0)="AEMQZ",DIC("A")="Select Service #1: "
50 F ZI=1:1 Q:XZ>10 D ^DIC Q:+Y<0 W:'$D(^ABS(503335,"AE",+Y)) !,"THERE ARE NO ENTRIES IN THE TIME CARD FILE FOR THIS SERVICE",*7 I $D(^(+Y)) S ABSVX("LIST",+Y)=$P(Y(0),"^",2),XZ=XZ+1,DIC("A")="Select Service #"_XZ_": "
51 K DIC I $D(ABSVX("LIST"))'>9 S X="No Services Selected.*" D MSG^ABSVQ G OUT
52 S BPROMPT="Select Beginning Month/Year: ",EPROMPT="Select Ending Month: ",MONTH=""
53 W ! D RANGE K MONTH
54 G:Y<0 OUT S ABSVX("EDATE")=EDATE,ABSVX("BDATE")=$E(BDATE,1,5)_"00"
55 S ZTRTN="SO1^ABSVTPR1",ZTDESC="VOLUNTARY SELECTED SERVICE LISTING",ZTSAVE("ABSV*")="",ZTSAVE("EDATE")="",ZTSAVE("BDATE")="" D ^ABSVQ D OUT Q
56SO1 ;DQ SELECTED SERVICE LISTING
57 K ^TMP("ABSVSELSERV",$J)
58 I '$D(ZTQUEUED) D WAIT^ABSVYN
59 S DA=0
60 F S DA=$O(ABSVX("LIST",DA)) Q:'DA D
61 . S N=0
62 . F S N=$O(^ABS(503335,"AE",DA,N)) Q:'N D
63 . . S X=^ABS(503335,N,0)
64 . . I $P(X,"^",12)=ABSV("SITE"),$P(X,"^",5)'<BDATE,$P(X,"^",5)'>EDATE S ^TMP("ABSVSELSERV",$J,N)=""
65 . . Q
66 . Q
67 K ABSVX("LIST") I '$D(^TMP("ABSVSELSERV",$J)) S X="No Time Cards Found.*" D:'$D(ZTQUEUED) MSG^ABSVQ D:$D(ZTQUEUED) KILL^%ZTLOAD G OUT
68 S IOP=ABIOP
69 S L=0,DIC="^ABS(503335,",BY="+#@1.3,+4,.01",(FR,TO)="",FLDS="[ABSV SERVICE LIST]",DHD="VOLUNTEER HOURS BY SERVICE",BY(0)="^TMP(""ABSVSELSERV"",$J,",L(0)=1
70 D EN1^DIP,DIKILL^ABSVQ
71 K ^TMP("ABSVSELSERV",$J)
72 I $D(ZTQUEUED) D KILL^%ZTLOAD Q
73 QUIT
74OLIST ;PRINT SUMMARY ORG REPORT FOR OCC HRS
75 D ^ABSVSITE Q:'%
76 S FULLDAT="" D RANGE Q:Y<1
77 S L=0,DIC="^ABS(503336,",FR=+BDATE,TO=+EDATE,DIS(0)="I $P($G(^ABS(503336,D0,0)),U,3)=ABSV(""SITE"")",(BY,FLDS)="[ABSV OCC HRS ORG SUMMARY]"
78 S DHD=ABSV("SITENAME")_" - OCCASSIONAL HOURS BY ORGANIZATION - "_$P(BDATE,"^",2)_" THRU "_$P(EDATE,"^",2)
79 D EN1^DIP,DIKILL^ABSVQ Q
80SLIST ;PRINT SUMMARY SERVICE REPORT
81 D ^ABSVSITE Q:'%
82 S FULLDAT="" D RANGE Q:Y<1
83 S L=0,DIC="^ABS(503336,",FR=+BDATE,TO=+EDATE,DIS(0)="I $P($G(^ABS(503336,D0,0)),U,3)=ABSV(""SITE"")",(BY,FLDS)="[ABSV OCC HRS SERV SUMMARY]"
84 S DHD=ABSV("SITENAME")_" - OCCASSIONAL HOURS BY SERVICE - "_$P(BDATE,"^",2)_" THRU "_$P(EDATE,"^",2)
85 D EN1^DIP,DIKILL^ABSVQ,OUT
86 QUIT
87OCCSUM ;PRINT OCCASSIONAL HRS SUMMARY
88 D ^ABSVSITE Q:'%
89 S FULLDAT="" D RANGE Q:Y<1
90 S L=0,DIC="^ABS(503336,",FR=+BDATE,TO=+EDATE,DIS(0)="I $P($G(^ABS(503336,D0,0)),U,3)=ABSV(""SITE"")",(BY,FLDS)="[ABSV OCC HRS SUMMARY]"
91 S DHD=ABSV("SITENAME")_" - OCCASSIONAL HOURS REPORT - "_$P(BDATE,"^",2)_" THRU "_$P(EDATE,"^",2)
92 D EN1^DIP,DIKILL^ABSVQ,OUT
93 QUIT
Note: See TracBrowser for help on using the repository browser.