close Warning: Can't use blame annotator:
svn blame failed on WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVSER3.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVSER3.m@ 691

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

initial load of WorldVistAEHR

File size: 2.2 KB
RevLine 
1ABSVSER3 ;VAMC ALTOONA/CTB - SERVER TO FILE DATA FROM AUSTIN ;11/4/99 1:19 PM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**3,9,18**;JULY 6, 1994
3HDR 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
16ONE(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
32YEAR(X) ;CONVERT COBOL YEAR TO FM YEAR EG 89 TO 289
33 Q $S($E(X)>3:2_X,1:3_X)
34STRIP(X) ;STRIP TRAILING BLANKS
35 F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
36 Q X
37BLANK(X) ;SET 0 TO BLANKS
38 I +X=0 S X=""
39 Q X
40ERR ;PROCESS ERROR MESSAGE
41 S ERRCOUNT=ERRCOUNT+1
42MSG S MSGLINE=$G(MSGLINE)+1
43 S XQSTXT(MSGLINE)=MSG
44 QUIT
45AWD(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)
Note: See TracBrowser for help on using the repository browser.