ABSVSER3 ;VAMC ALTOONA/CTB - SERVER TO FILE DATA FROM AUSTIN  ;11/4/99  1:19 PM
V ;;4.0;VOLUNTARY TIMEKEEPING;**3,9,18**;JULY 6, 1994
HDR K X,DELIM,SITE,MSGDATE
 S X=XMRG,DELIM=$E(X,6),SITE=$$STRIP($P(X,DELIM,2)),MSGDATE=$P(X,DELIM,3)
 S MSG="PROCESSING ANNUAL PURGE MESSAGE" D MSG
 S MSG="   " D MSG
 F  X XMREC Q:XMER'=0  D
 . S X=XMRG,TYPE=$P(X,DELIM)
 . I TYPE=1 D ONE(X,SITE,DELIM)
 . QUIT
 S $P(^ABS(503339.1,MFILEDA,0),"^",3)="S"
 I '$D(MSGLINE) S XQSTXT(1)=" ",XQSTXT(2)="No errors found during processing for station "_$G(SITE) S MSGLINE=3
 S XQSTXT(MSGLINE)=RECCOUNT_" records processed into master file." S MSGLINE=MSGLINE+1
 S XQSTXT(MSGLINE)=ERRCOUNT_" records bypassed."
 S DONE=1 QUIT
ONE(X,SITE,DEL) N PSEUDO,SSN,DPURGED,SITEDA,MSG
 S PSEUDO=$P(X,DEL,2),SSN=$P(X,DEL,3),DPURGED=$P(X,DEL,4),DPURGED=($E(DPURGED,3,6)-1700)_$E(DPURGED,1,2)_"00"
 ;LOOKUP STATION NUMBER FOR INTERNAL NUMBER ON 4 NODE
 S SITEDA=$O(^ABS(503338,"AD",SITE,0)) I SITEDA="" S MSG="Station number "_SITE_" on record "_$$EXTSSN^ABSVU2(SSN)_" not found in file 503338." D ERR QUIT
 ;LOOKUP VOLUNTEER
 S VOLDA=$O(^ABS(503330,"D",SSN,0)) I $S(VOLDA="":1,'$D(^ABS(503330,VOLDA)):1,1:0) S MSG="No volunteer record found with SSN "_$$EXTSSN^ABSVU2(SSN)_"." D ERR QUIT
 ;CHECK FOR STATION ENTRY
 I '$D(^ABS(503330,VOLDA,4,SITEDA,0)) S MSG="Volunteer "_$$EXTSSN^ABSVU2(SSN)_" has no record for station "_SITE_".~" D ERR QUIT
 L +^ABS(503330,VOLDA,4,SITEDA,0):20 ELSE  S MSG="Unable to post record for SSN "_$$EXTSSN^ABSVU2(SSN)_" due to record lock.~" D ERR QUIT
 S X=^ABS(503330,VOLDA,4,SITEDA,0),$P(X,"^",10,11)="Y^"_DPURGED
 S:$P(X,"^",8)="" $P(X,"^",8)=DPURGED
 S MSG=$$EXTSSN^ABSVU2(SSN)_" MARKED AS PURGED." D MSG
 S ^ABS(503330,VOLDA,4,SITEDA,0)=X
 S RECCOUNT=RECCOUNT+1
 L -^ABS(503330,VOLDA,4,SITEDA,0)
 QUIT
YEAR(X) ;CONVERT COBOL YEAR TO FM YEAR EG 89 TO 289
 Q $S($E(X)>3:2_X,1:3_X)
STRIP(X) ;STRIP TRAILING BLANKS
 F  Q:$E(X,$L(X))'=" "  S X=$E(X,1,($L(X)-1))
 Q X
BLANK(X) ;SET 0 TO BLANKS
 I +X=0 S X=""
 Q X
ERR ;PROCESS ERROR MESSAGE
 S ERRCOUNT=ERRCOUNT+1
MSG S MSGLINE=$G(MSGLINE)+1
 S XQSTXT(MSGLINE)=MSG
 QUIT
AWD(X,Y,Z) ;
 S X=$$BLANK(X)
 I +X=0,Y="",Z="" Q ""
 I Y="",Z="" Q +X
 I Y="" S Y=" "
 Q (+X_"/"_$$FULLDAT^ABSVU2(Y)_"/"_Z)