RMPRCOR ;PHX/HPL - RECALCULATES TOTAL HOURS FOR LAB JOB FOR FILE 660 ;03/12/96
;;3.0;PROSTHETICS;**2**;Feb 09, 1996
Q
DOIT ;LOOPS THROUGH FILE 660, USES "C" X-REFF IN FILE 664.3 TO FIND
;THE HOURS FOR THE TRANSACTION, AND ADDS THEM UP BY $ORDERING THROUGH
;THE "C" X-REFF FOR FILE 664.3 THEN STORES THE RESULTS IN FILE 660
LKAT660 ;$ORDER THROUGH FILE 660
S LP=0,RLP=0
F S THRS=0,LP=$O(^RMPR(660,LP)) Q:LP'>0 D
.Q:'$D(^RMPR(660,LP,"LB"))
.S RMPRDA=+LP
.D SM6643
.S $P(^RMPR(660,RMPRDA,"LB"),U,6)=THRS
G EXIT
Q
SM6643 ;$ORDER THROUGH FILE 664.3
F S RLP=$O(^RMPR(664.3,"C",LP,RLP)) Q:RLP'>0 D
.S RDA=+RLP
.S RMLP=0 D SUMIT
Q
SUMIT ;SUM THE ENTRIES
N HRS
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
Q
EXIT ;COMMON EXIT
K LP,RLP,RMLP
W !,"DONE RECALCULATING !"
H 5 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRCOR 887 printed Sep 23, 2025@20:10:13 Page 2
RMPRCOR ;PHX/HPL - RECALCULATES TOTAL HOURS FOR LAB JOB FOR FILE 660 ;03/12/96
+1 ;;3.0;PROSTHETICS;**2**;Feb 09, 1996
+2 QUIT
DOIT ;LOOPS THROUGH FILE 660, USES "C" X-REFF IN FILE 664.3 TO FIND
+1 ;THE HOURS FOR THE TRANSACTION, AND ADDS THEM UP BY $ORDERING THROUGH
+2 ;THE "C" X-REFF FOR FILE 664.3 THEN STORES THE RESULTS IN FILE 660
LKAT660 ;$ORDER THROUGH FILE 660
+1 SET LP=0
SET RLP=0
+2 FOR
SET THRS=0
SET LP=$ORDER(^RMPR(660,LP))
if LP'>0
QUIT
Begin DoDot:1
+3 if '$DATA(^RMPR(660,LP,"LB"))
QUIT
+4 SET RMPRDA=+LP
+5 DO SM6643
+6 SET $PIECE(^RMPR(660,RMPRDA,"LB"),U,6)=THRS
End DoDot:1
+7 GOTO EXIT
+8 QUIT
SM6643 ;$ORDER THROUGH FILE 664.3
+1 FOR
SET RLP=$ORDER(^RMPR(664.3,"C",LP,RLP))
if RLP'>0
QUIT
Begin DoDot:1
+2 SET RDA=+RLP
+3 SET RMLP=0
DO SUMIT
End DoDot:1
+4 QUIT
SUMIT ;SUM THE ENTRIES
+1 NEW HRS
+2 SET RMLP=$ORDER(^RMPR(664.3,RDA,1,RMLP))
if RMLP'>0
QUIT
SET RMDA=+RMLP
SET HRS=$PIECE(^RMPR(664.3,RDA,1,RMDA,0),U,2)
SET THRS=THRS+HRS
+3 QUIT
EXIT ;COMMON EXIT
+1 KILL LP,RLP,RMLP
+2 WRITE !,"DONE RECALCULATING !"
+3 HANG 5
QUIT
