40 lines
1.8 KiB
Mathematica
40 lines
1.8 KiB
Mathematica
|
ABSVSCAN ;VAMC ALTOONA/CTB - SCAN FOR MAX ENTRIES ;3/11/94 9:07 AM
|
||
|
|
V ;;4.0;VOLUNTARY TIMEKEEPING;;JULY 6, 1994
|
||
|
|
;SELECT MONTH
|
||
|
|
NEW %DT,B,COUNT,COMB,DA,DIJ,DP,MONTH,NAME,NUMBER,P,VOLDA,X,Y
|
||
|
|
D ^ABSVSITE Q:'%
|
||
|
|
S %DT="AEQ",%DT("A")="Select MONTH/YEAR to Scan: " D ^%DT
|
||
|
|
Q:Y<0
|
||
|
|
S MONTH=$E(Y,1,5)_"00"
|
||
|
|
S ZTRTN="DQ^ABSVSCAN",ZTSAVE("MONTH")="",ZTSAVE("ABSV*")="",ZTDESC="Scan Volunteer Daily Entries" D ^ABSVQ
|
||
|
|
QUIT
|
||
|
|
;LOOP THROUGH MONTH CROSS REFERENCE
|
||
|
|
DQ ;
|
||
|
|
;CLEAR ^TMP("ABSVSCAN")
|
||
|
|
K ^TMP("ABSVSCAN",$J)
|
||
|
|
S DA=0 F D Q:'DA
|
||
|
|
. F I=1:1:10 S DA=$O(^ABS(503331,"AF",MONTH,DA)) Q:'DA D
|
||
|
|
. . N COMB,NAME
|
||
|
|
. . Q:'DA
|
||
|
|
. . S X=$G(^ABS(503331,DA,0)) Q:X=""!($P(X,"^",7)'=ABSV("SITE"))
|
||
|
|
. . S COMB=$P(X,"^",6),NAME=+X
|
||
|
|
. . I COMB]"",NAME S ^TMP("ABSVSCAN",$J,NAME,COMB)=($G(^TMP("ABSVSCAN",$J,NAME,COMB))+1)
|
||
|
|
. . QUIT
|
||
|
|
. QUIT
|
||
|
|
I $D(^TMP("ABSVSCAN",$J)) S VOLDA="" F S VOLDA=$O(^TMP("ABSVSCAN",$J,VOLDA)) Q:VOLDA="" S COMB="" D
|
||
|
|
. 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)
|
||
|
|
. QUIT
|
||
|
|
K ^TMP("ABSVSCAN",$J)
|
||
|
|
I $D(^TMP("ABSVSCAN1",$J)) S NAME="",COUNT=1 F S NAME=$O(^TMP("ABSVSCAN1",$J,NAME)) Q:NAME="" S VOLDA=0 D
|
||
|
|
. F S VOLDA=$O(^TMP("ABSVSCAN1",$J,NAME,VOLDA)) Q:'VOLDA S COMB="" D
|
||
|
|
. . 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
|
||
|
|
. . QUIT
|
||
|
|
. QUIT
|
||
|
|
K ^TMP("ABSVSCAN1",$J)
|
||
|
|
I '$D(^TMP("ABSVSCAN",$J)) S X="NO VOLUNTEER WITH MORE THAN 26 DAYS WAS FOUND.*" D MSG^ABSVQ QUIT
|
||
|
|
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
|
||
|
|
S FLDS="[ABSV SCAN]"
|
||
|
|
S IOP=ABIOP D EN1^DIP
|
||
|
|
K ^TMP("ABSVSCAN",$J)
|
||
|
|
QUIT
|