source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVFIX.m@ 1801

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

initial load of WorldVistAEHR

File size: 1.6 KB
RevLine 
[613]1ABSVFIX ;VAMC ALTOONA/CTB - FIX COMBINATIONS WHEN NECESSARY ;3/9/00 9:22 AM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**10,20**;JULY 6, 1994
3 ;FIX ALL COMBINATIONS FOR ALL VOLUNTEERS
4 N VOLDA,VOLNAME,COMBDA,ORGDA,SERDA,SCHDA
5 S VOLNAME="" F S VOLNAME=$O(^ABS(503330,"B",VOLNAME)) Q:VOLNAME="" S VOLDA=0 F S VOLDA=$O(^ABS(503330,"B",VOLNAME,VOLDA)) Q:'VOLDA W !,$P(^ABS(503330,VOLDA,0),"^") D COMB
6 W !!,"FIX OF COMBINATIONS HAS BEEN COMPLETED",!! Q
7COMB S COMBDA=0 F S COMBDA=$O(^ABS(503330,VOLDA,1,COMBDA)) Q:'COMBDA I $D(^(COMBDA,0)) D FIX
8 Q
9FIX S X=^ABS(503330,VOLDA,1,COMBDA,0)
10 N COMB,ORG,ORGDA,SCH,SCHDA,SER,SERDA
11 S COMB=$P(X,"^",5)
12 S ORG=$E(COMB,1,3) I ORG]"" S ORGDA=$O(^ABS(503334,"B",ORG,0)) S:ORGDA $P(X,"^",2)=ORGDA
13 S SCH=$E(COMB,4) I SCH]"" S SCHDA=$O(^ABS(503333,"B",SCH,0)) S:SCHDA $P(X,"^",3)=SCHDA
14 S SER=$E(COMB,5,9) I SER]"" S SERDA=$O(^ABS(503332,"B",SER,0)) S:SERDA $P(X,"^",4)=SERDA
15 S ^ABS(503330,VOLDA,1,COMBDA,0)=X
16 W "." Q
17XREF ;IDENTIFY DATA PROBLEM IN FILE 503330, FIELD #.1 SUBFIELD #.01
18 S N=0 F S N=$O(^ABS(503330,N)) Q:'N D
19 . S M=0 F S M=$O(^ABS(503330,N,4,M)) Q:'M D
20 . . S X=$P($G(^ABS(503330,N,4,M,0)),"^",1) I X=M Q
21 . . I X]"",$D(^ABS(503330,N,4,"B",X,X)) Q
22 . . S ^ABS(503330,N,4,"B",M,M)="",$P(^ABS(503330,N,4,M,0),"^",1)=M
23 . . QUIT
24 . QUIT
25 QUIT
26UNTERM ;LOOP THROUGH MASTER FILE AND DELETE TERMINATIONS FOR TERMINATION DATES = 3000000
27 N VOLDA,STANUM,X
28 S VOLDA=0 F S VOLDA=$O(^ABS(503330,VOLDA)) Q:'VOLDA W "." S STANUM=0 F S STANUM=$O(^ABS(503330,VOLDA,4,STANUM)) Q:'STANUM D
29 . S X=$G(^ABS(503330,VOLDA,4,STANUM,0)) I $P(X,"^",8)="3000000" S $P(^ABS(503330,VOLDA,4,STANUM,0),"^",8)=""
30 . Q
Note: See TracBrowser for help on using the repository browser.