source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRCOR.m@ 1006

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

initial load of WorldVistAEHR

File size: 859 bytes
RevLine 
[613]1RMPRCOR ;PHX/HPL - RECALCULATES TOTAL HOURS FOR LAB JOB FOR FILE 660 ;03/12/96
2 ;;3.0;PROSTHETICS;**2**;Feb 09, 1996
3 Q
4DOIT ;LOOPS THROUGH FILE 660, USES "C" X-REFF IN FILE 664.3 TO FIND
5 ;THE HOURS FOR THE TRANSACTION, AND ADDS THEM UP BY $ORDERING THROUGH
6 ;THE "C" X-REFF FOR FILE 664.3 THEN STORES THE RESULTS IN FILE 660
7LKAT660 ;$ORDER THROUGH FILE 660
8 S LP=0,RLP=0
9 F S THRS=0,LP=$O(^RMPR(660,LP)) Q:LP'>0 D
10 .Q:'$D(^RMPR(660,LP,"LB"))
11 .S RMPRDA=+LP
12 .D SM6643
13 .S $P(^RMPR(660,RMPRDA,"LB"),U,6)=THRS
14 G EXIT
15 Q
16SM6643 ;$ORDER THROUGH FILE 664.3
17 F S RLP=$O(^RMPR(664.3,"C",LP,RLP)) Q:RLP'>0 D
18 .S RDA=+RLP
19 .S RMLP=0 D SUMIT
20 Q
21SUMIT ;SUM THE ENTRIES
22 N HRS
23 S RMLP=$O(^RMPR(664.3,RDA,1,RMLP)) Q:RMLP'>0 S RMDA=+RMLP S HRS=$P(^RMPR(664.3,RDA,1,RMDA,0),U,2),THRS=THRS+HRS
24 Q
25EXIT ;COMMON EXIT
26 K LP,RLP,RMLP
27 W !,"DONE RECALCULATING !"
28 H 5 Q
Note: See TracBrowser for help on using the repository browser.