RMPRPS42 ;HISC/RVD - POST INIT FOR LAB TIME ENTRY; 12/8/99
;;3.0;PROSTHETICS;**42**;Feb 09,1996
W !,$C(7),"Invalid Entry......"
Q
LABTIM ;Populate the pre-determined time from the table DAT+
S U="^"
W @IOF,"Entering LAB time......."
F I=1:1 S RMDAT=$P($T(DAT+I),";",3) Q:RMDAT="" S RHCPC=$P(RMDAT,U,1),RMTIME=$P(RMDAT,U,2),RMHC=$O(^RMPR(661.1,"B",RHCPC,0)) I RMHC S:RMTIME="" RMTIME=15 S $P(^RMPR(661.1,RMHC,0),U,10)=RMTIME
W !,"Done Entering Lab time......."
G KILL
;
INIT ;Initialize all the ITEM from SHORT DESCRIPTION
;
W !!,"Start Initialization of Items......."
S DLAYGO=661.1,DIC(0)="L"
RET F I=0:0 S I=$O(^RMPR(661.1,I)) Q:I'>0 S RMDES=$P(^RMPR(661.1,I,0),U,2) D:RMDES'=""
.S X=$P(RMDES," ",1),X=$E(X,1,26),X=X_"/COMMERCIAL"
.Q:$D(^RMPR(661.1,I,3,"B"))
.S $P(^RMPR(661.1,I,3,0),U,2)=661.12,DA(1)=I,DIC="^RMPR(661.1,"_DA(1)_",3,"
.D FILE^DICN
W !!,"Done Initialization of Items......."
;
KILL K I,J,RMIEN,RMPAT,RMSCAT,RMFRM,RMDAT0,RMDATAM,RMCHK,RMTYP,RMGRP,RMSRC
K RMDAT,RMHC,DA,RMDES,X,DIC,DLAYGO,R0,RH,RI,RIT,RMHCPC,RMIT,RLO,RHC
Q
;
DEL ;clean-up all line items in node 3.
F I=0:0 S I=$O(^RMPR(661.1,I)) Q:I'>0 K ^RMPR(661.1,I,3)
G KILL
;
DAT ;;table for lab pre-determined time
;;L4350
;;L1902
;;L8230
;;L0940
;;E0191
;;L4360
;;L0100
;;L0172
;;L0120
;;L0140
;;L0500
;;E0110
;;E0112
;;E0240
;;A4927
;;L3050
;;A4500
;;L8130
;;L8100
;;L8210
;;L8150
;;L8120
;;L8190
;;L1830
;;A4565
;;L1832
;;L5667
;;L4310
;;L0520
;;E0191
;;L3999
;;L2999
;;L3221
;;L0120
;;L1825
;;L1810
;;L3700
;;L0370
;;L3980
;;L3908
;;L3660
;;L5674
;;L0430
;;L8300
;;E0152
;;E0150
;;L1804
;;L1930^90
;;L1845^60
;;L0810^60
;;L1680^60
;;L0520^45
;;L1832^45
;;L0190^45
;;L0430^60
;;L0370^45
;;E0443^30
;;L3010^90
;;L3040^45
;;L3310^45
;;L3003^30
;;L3002^45
;;L3003
;;L3332^30
;;L3265
;;L3260
;;L3250^90
;;L3230^90
;;L3221^45
;;L3253^45
;;L3216^45
;;L3420^45
;;L3649
;;L5450^60
;;L8410
;;L8400
;;L8460
;;L8440
;;L8430
;;L8417
;;L8420
;;L5662^30
;;L5675^30
;;L7510^30
;;E0100
;;K0108
;;L1660
;;L3800
;;L3930
;;A4637
;;E0151
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPS42 2236 printed Nov 22, 2024@17:47:29 Page 2
RMPRPS42 ;HISC/RVD - POST INIT FOR LAB TIME ENTRY; 12/8/99
+1 ;;3.0;PROSTHETICS;**42**;Feb 09,1996
+2 WRITE !,$CHAR(7),"Invalid Entry......"
+3 QUIT
LABTIM ;Populate the pre-determined time from the table DAT+
+1 SET U="^"
+2 WRITE @IOF,"Entering LAB time......."
+3 FOR I=1:1
SET RMDAT=$PIECE($TEXT(DAT+I),";",3)
if RMDAT=""
QUIT
SET RHCPC=$PIECE(RMDAT,U,1)
SET RMTIME=$PIECE(RMDAT,U,2)
SET RMHC=$ORDER(^RMPR(661.1,"B",RHCPC,0))
IF RMHC
if RMTIME=""
SET RMTIME=15
SET $PIECE(^RMPR(661.1,RMHC,0),U,10)=RMTIME
+4 WRITE !,"Done Entering Lab time......."
+5 GOTO KILL
+6 ;
INIT ;Initialize all the ITEM from SHORT DESCRIPTION
+1 ;
+2 WRITE !!,"Start Initialization of Items......."
+3 SET DLAYGO=661.1
SET DIC(0)="L"
RET FOR I=0:0
SET I=$ORDER(^RMPR(661.1,I))
if I'>0
QUIT
SET RMDES=$PIECE(^RMPR(661.1,I,0),U,2)
if RMDES'=""
Begin DoDot:1
+1 SET X=$PIECE(RMDES," ",1)
SET X=$EXTRACT(X,1,26)
SET X=X_"/COMMERCIAL"
+2 if $DATA(^RMPR(661.1,I,3,"B"))
QUIT
+3 SET $PIECE(^RMPR(661.1,I,3,0),U,2)=661.12
SET DA(1)=I
SET DIC="^RMPR(661.1,"_DA(1)_",3,"
+4 DO FILE^DICN
End DoDot:1
+5 WRITE !!,"Done Initialization of Items......."
+6 ;
KILL KILL I,J,RMIEN,RMPAT,RMSCAT,RMFRM,RMDAT0,RMDATAM,RMCHK,RMTYP,RMGRP,RMSRC
+1 KILL RMDAT,RMHC,DA,RMDES,X,DIC,DLAYGO,R0,RH,RI,RIT,RMHCPC,RMIT,RLO,RHC
+2 QUIT
+3 ;
DEL ;clean-up all line items in node 3.
+1 FOR I=0:0
SET I=$ORDER(^RMPR(661.1,I))
if I'>0
QUIT
KILL ^RMPR(661.1,I,3)
+2 GOTO KILL
+3 ;
DAT ;;table for lab pre-determined time
+1 ;;L4350
+2 ;;L1902
+3 ;;L8230
+4 ;;L0940
+5 ;;E0191
+6 ;;L4360
+7 ;;L0100
+8 ;;L0172
+9 ;;L0120
+10 ;;L0140
+11 ;;L0500
+12 ;;E0110
+13 ;;E0112
+14 ;;E0240
+15 ;;A4927
+16 ;;L3050
+17 ;;A4500
+18 ;;L8130
+19 ;;L8100
+20 ;;L8210
+21 ;;L8150
+22 ;;L8120
+23 ;;L8190
+24 ;;L1830
+25 ;;A4565
+26 ;;L1832
+27 ;;L5667
+28 ;;L4310
+29 ;;L0520
+30 ;;E0191
+31 ;;L3999
+32 ;;L2999
+33 ;;L3221
+34 ;;L0120
+35 ;;L1825
+36 ;;L1810
+37 ;;L3700
+38 ;;L0370
+39 ;;L3980
+40 ;;L3908
+41 ;;L3660
+42 ;;L5674
+43 ;;L0430
+44 ;;L8300
+45 ;;E0152
+46 ;;E0150
+47 ;;L1804
+48 ;;L1930^90
+49 ;;L1845^60
+50 ;;L0810^60
+51 ;;L1680^60
+52 ;;L0520^45
+53 ;;L1832^45
+54 ;;L0190^45
+55 ;;L0430^60
+56 ;;L0370^45
+57 ;;E0443^30
+58 ;;L3010^90
+59 ;;L3040^45
+60 ;;L3310^45
+61 ;;L3003^30
+62 ;;L3002^45
+63 ;;L3003
+64 ;;L3332^30
+65 ;;L3265
+66 ;;L3260
+67 ;;L3250^90
+68 ;;L3230^90
+69 ;;L3221^45
+70 ;;L3253^45
+71 ;;L3216^45
+72 ;;L3420^45
+73 ;;L3649
+74 ;;L5450^60
+75 ;;L8410
+76 ;;L8400
+77 ;;L8460
+78 ;;L8440
+79 ;;L8430
+80 ;;L8417
+81 ;;L8420
+82 ;;L5662^30
+83 ;;L5675^30
+84 ;;L7510^30
+85 ;;E0100
+86 ;;K0108
+87 ;;L1660
+88 ;;L3800
+89 ;;L3930
+90 ;;A4637
+91 ;;E0151
