source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVTPR2.m

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1ABSVTPR2 ;VAMC ALTOONA/CTB - PRINT OCC HRS - SELECTED ORGS ;5/22/97 11:16 AM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**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
5SELORG ;PRINT SELECTED ORGANIZATIONS
6 D ^ABSVSITE Q:'%
7 S X="Using this option you may select up to 10 organization to print out per session.*" D MSG^ABSVQ W !
8 S XZ=1,DIC=503334,DIC(0)="AEMNQZ",DIC("A")="Select Organization #1: "
9 F ZI=1:1 Q:XZ>10 D ^DIC Q:+Y<0 W:'$D(^ABS(503336,"D",+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_": "
10 K DIC I $D(ABSVX("LIST"))'>9 S X="No Organizations Selected.*" D MSG^ABSVQ G OUT
11 S BPROMPT="Select Beginning Month/Year: ",EPROMPT="Select Ending Month: ",MONTH=""
12 W ! D RANGE^ABSVTPR1 K MONTH
13 G:Y<0 OUT
14 S ABSVX("EDATE")=EDATE,ABSVX("BDATE")=$E(BDATE,1,5)_"00"
15 S ZTRTN="SO1^ABSVTPR2",ZTDESC="VOLUNTARY SELECTED ORGANIZATION LISTING - OCCASIONAL HOURS",ZTSAVE("ABSV*")="",ZTSAVE("EDATE")="",ZTSAVE("BDATE")="" D ^ABSVQ D OUT Q
16SO1 ;DQ SELECTED ORG LISTING
17 K ^TMP("ABSVSELORG",$J)
18 I '$D(ZTQUEUED) D WAIT^ABSVYN
19 S DA=0
20 F S DA=$O(ABSVX("LIST",DA)) Q:'DA D
21 . S N=0
22 . F S N=$O(^ABS(503336,"D",DA,N)) Q:'N D
23 . . S X=^ABS(503336,N,0)
24 . . I $P(X,"^",3)=ABSV("SITE"),$P(X,"^",8)'<BDATE,$P(X,"^",8)'>EDATE S ^TMP("ABSVSELORG",$J,N)=""
25 . . Q
26 . Q
27 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
28 S IOP=ABIOP
29 S L=0,DIC="^ABS(503336,"
30 S FR=",",TO=","
31 S BY="#@+3.5;S2",FLDS="[ABSV OCC HRS ORG SUMMARY]",BY(0)="^TMP(""ABSVSELORG"","_$J_",",L(0)=1
32 D EN1^DIP,DIKILL^ABSVQ
33 ;K ^TMP("ABSVSELORG",$J)
34 I $D(ZTQUEUED) D KILL^%ZTLOAD Q
35 QUIT
Note: See TracBrowser for help on using the repository browser.