| [613] | 1 | ABSVSER3 ;VAMC ALTOONA/CTB - SERVER TO FILE DATA FROM AUSTIN ;11/4/99 1:19 PM
|
|---|
| 2 | V ;;4.0;VOLUNTARY TIMEKEEPING;**3,9,18**;JULY 6, 1994
|
|---|
| 3 | HDR K X,DELIM,SITE,MSGDATE
|
|---|
| 4 | S X=XMRG,DELIM=$E(X,6),SITE=$$STRIP($P(X,DELIM,2)),MSGDATE=$P(X,DELIM,3)
|
|---|
| 5 | S MSG="PROCESSING ANNUAL PURGE MESSAGE" D MSG
|
|---|
| 6 | S MSG=" " D MSG
|
|---|
| 7 | F X XMREC Q:XMER'=0 D
|
|---|
| 8 | . S X=XMRG,TYPE=$P(X,DELIM)
|
|---|
| 9 | . I TYPE=1 D ONE(X,SITE,DELIM)
|
|---|
| 10 | . QUIT
|
|---|
| 11 | S $P(^ABS(503339.1,MFILEDA,0),"^",3)="S"
|
|---|
| 12 | I '$D(MSGLINE) S XQSTXT(1)=" ",XQSTXT(2)="No errors found during processing for station "_$G(SITE) S MSGLINE=3
|
|---|
| 13 | S XQSTXT(MSGLINE)=RECCOUNT_" records processed into master file." S MSGLINE=MSGLINE+1
|
|---|
| 14 | S XQSTXT(MSGLINE)=ERRCOUNT_" records bypassed."
|
|---|
| 15 | S DONE=1 QUIT
|
|---|
| 16 | ONE(X,SITE,DEL) N PSEUDO,SSN,DPURGED,SITEDA,MSG
|
|---|
| 17 | 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"
|
|---|
| 18 | ;LOOKUP STATION NUMBER FOR INTERNAL NUMBER ON 4 NODE
|
|---|
| 19 | 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
|
|---|
| 20 | ;LOOKUP VOLUNTEER
|
|---|
| 21 | 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
|
|---|
| 22 | ;CHECK FOR STATION ENTRY
|
|---|
| 23 | I '$D(^ABS(503330,VOLDA,4,SITEDA,0)) S MSG="Volunteer "_$$EXTSSN^ABSVU2(SSN)_" has no record for station "_SITE_".~" D ERR QUIT
|
|---|
| 24 | 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
|
|---|
| 25 | S X=^ABS(503330,VOLDA,4,SITEDA,0),$P(X,"^",10,11)="Y^"_DPURGED
|
|---|
| 26 | S:$P(X,"^",8)="" $P(X,"^",8)=DPURGED
|
|---|
| 27 | S MSG=$$EXTSSN^ABSVU2(SSN)_" MARKED AS PURGED." D MSG
|
|---|
| 28 | S ^ABS(503330,VOLDA,4,SITEDA,0)=X
|
|---|
| 29 | S RECCOUNT=RECCOUNT+1
|
|---|
| 30 | L -^ABS(503330,VOLDA,4,SITEDA,0)
|
|---|
| 31 | QUIT
|
|---|
| 32 | YEAR(X) ;CONVERT COBOL YEAR TO FM YEAR EG 89 TO 289
|
|---|
| 33 | Q $S($E(X)>3:2_X,1:3_X)
|
|---|
| 34 | STRIP(X) ;STRIP TRAILING BLANKS
|
|---|
| 35 | F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
|
|---|
| 36 | Q X
|
|---|
| 37 | BLANK(X) ;SET 0 TO BLANKS
|
|---|
| 38 | I +X=0 S X=""
|
|---|
| 39 | Q X
|
|---|
| 40 | ERR ;PROCESS ERROR MESSAGE
|
|---|
| 41 | S ERRCOUNT=ERRCOUNT+1
|
|---|
| 42 | MSG S MSGLINE=$G(MSGLINE)+1
|
|---|
| 43 | S XQSTXT(MSGLINE)=MSG
|
|---|
| 44 | QUIT
|
|---|
| 45 | AWD(X,Y,Z) ;
|
|---|
| 46 | S X=$$BLANK(X)
|
|---|
| 47 | I +X=0,Y="",Z="" Q ""
|
|---|
| 48 | I Y="",Z="" Q +X
|
|---|
| 49 | I Y="" S Y=" "
|
|---|
| 50 | Q (+X_"/"_$$FULLDAT^ABSVU2(Y)_"/"_Z)
|
|---|
