| [613] | 1 | ABSVSCAN ;VAMC ALTOONA/CTB - SCAN FOR MAX ENTRIES ;3/11/94 9:07 AM
|
|---|
| 2 | V ;;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
|
|---|
| 12 | DQ ;
|
|---|
| 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
|
|---|
