source: FOIAVistA/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVSCAN.m@ 1755

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

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1ABSVSCAN ;VAMC ALTOONA/CTB - SCAN FOR MAX ENTRIES ;3/11/94 9:07 AM
2V ;;4.0;VOLUNTARY TIMEKEEPING;;JULY 6, 1994
3 ;SELECT MONTH
4 NEW %DT,B,COUNT,COMB,DA,DIJ,DP,MONTH,NAME,NUMBER,P,VOLDA,X,Y
5 D ^ABSVSITE Q:'%
6 S %DT="AEQ",%DT("A")="Select MONTH/YEAR to Scan: " D ^%DT
7 Q:Y<0
8 S MONTH=$E(Y,1,5)_"00"
9 S ZTRTN="DQ^ABSVSCAN",ZTSAVE("MONTH")="",ZTSAVE("ABSV*")="",ZTDESC="Scan Volunteer Daily Entries" D ^ABSVQ
10 QUIT
11 ;LOOP THROUGH MONTH CROSS REFERENCE
12DQ ;
13 ;CLEAR ^TMP("ABSVSCAN")
14 K ^TMP("ABSVSCAN",$J)
15 S DA=0 F D Q:'DA
16 . F I=1:1:10 S DA=$O(^ABS(503331,"AF",MONTH,DA)) Q:'DA D
17 . . N COMB,NAME
18 . . Q:'DA
19 . . S X=$G(^ABS(503331,DA,0)) Q:X=""!($P(X,"^",7)'=ABSV("SITE"))
20 . . S COMB=$P(X,"^",6),NAME=+X
21 . . I COMB]"",NAME S ^TMP("ABSVSCAN",$J,NAME,COMB)=($G(^TMP("ABSVSCAN",$J,NAME,COMB))+1)
22 . . QUIT
23 . QUIT
24 I $D(^TMP("ABSVSCAN",$J)) S VOLDA="" F S VOLDA=$O(^TMP("ABSVSCAN",$J,VOLDA)) Q:VOLDA="" S COMB="" D
25 . F S COMB=$O(^TMP("ABSVSCAN",$J,VOLDA,COMB)) Q:COMB="" I ^TMP("ABSVSCAN",$J,VOLDA,COMB)>26 S ^TMP("ABSVSCAN1",$J,$P(^ABS(503330,VOLDA,0),"^"),VOLDA,COMB)=^TMP("ABSVSCAN",$J,VOLDA,COMB)
26 . QUIT
27 K ^TMP("ABSVSCAN",$J)
28 I $D(^TMP("ABSVSCAN1",$J)) S NAME="",COUNT=1 F S NAME=$O(^TMP("ABSVSCAN1",$J,NAME)) Q:NAME="" S VOLDA=0 D
29 . F S VOLDA=$O(^TMP("ABSVSCAN1",$J,NAME,VOLDA)) Q:'VOLDA S COMB="" D
30 . . F S COMB=$O(^TMP("ABSVSCAN1",$J,NAME,VOLDA,COMB)) Q:COMB="" S NUMBER=^(COMB),^TMP("ABSVSCAN",$J,COUNT)=VOLDA_"^"_NUMBER_"^"_COMB S COUNT=COUNT+1
31 . . QUIT
32 . QUIT
33 K ^TMP("ABSVSCAN1",$J)
34 I '$D(^TMP("ABSVSCAN",$J)) S X="NO VOLUNTEER WITH MORE THAN 26 DAYS WAS FOUND.*" D MSG^ABSVQ QUIT
35 S DIC="^ABS(503330,",BY="@NUMBER",COUNT=$O(^TMP("ABSVSCAN",$J,0)),FR=+^TMP("ABSVSCAN",$J,COUNT),FR=$S(+FR:FR,1:99999999),TO=99999999
36 S FLDS="[ABSV SCAN]"
37 S IOP=ABIOP D EN1^DIP
38 K ^TMP("ABSVSCAN",$J)
39 QUIT
Note: See TracBrowser for help on using the repository browser.