RMPR29MG ;OI-HINES/SPS -OWL MATERIAL LABOR/HRS ENTER/EDIT RPC;12/27/2004
;;3.0;PROSTHETICS;**75**;Feb 09, 1996;Build 25
A1(RMAED,RMPRSITE,RMIE1,RMIE2,RMIE22,RMMAT,RMQTY,RMMCOST,RMVC,RMVEN,RMUI,RMSN,RMPST,RMPRTXT) ;roll and scroll entry point
G A2
;Material entry
EN(RESULTS,RMAED,RMIE1,RMIE2,RMIE22,RMMAT,RMQTY,RMMCOST,RMVC,RMVEN,RMUI,RMSN,RMPST,RMPRTXT) ;RPC entry point
A2 ;
S RESULTS(0)="",RMPRWO=RMIE2
K ^TMP($J)
;
; If no Tech assigned then self assign here
I +$P(^RMPR(664.1,RMIE1,0),U,16)'>0 S $P(^(0),U,16)=DUZ,$P(^(0),U,17)="A",$P(^(7),U,1)=DT,$P(^(7),U,3)=DUZ
I RMAED="D" D DEL Q
;
S DA660=+$P(^RMPR(664.2,RMPRWO,0),U,2)
S RMERR=0
I RMIE22="" S RMIE22="+1,"_RMIE2
E S RMIE22E=RMIE22,RMIE22=RMIE22_","_RMIE2
S RMDAT(664.22,RMIE22_",",.01)=RMMAT
S RMDAT(664.22,RMIE22_",",1)=RMQTY
S RMDAT(664.22,RMIE22_",",2)=RMMCOST
S RMDAT(664.22,RMIE22_",",3)=RMVC
S RMDAT(664.22,RMIE22_",",5)=RMVEN
S RMDAT(664.22,RMIE22_",",6)=RMUI
S RMDAT(664.22,RMIE22_",",7)=RMSN
S RMDAT(664.22,RMIE22_",",13)=RMPST
D UPDATE^DIE("","RMDAT","RMIEN","RMERROR")
S J=""
F S J=$O(RMPRTXT(J)) Q:J="" D
. S L=J+1,RMPRTXTF(L)=RMPRTXT(J)
I '$D(RMIEN(1)) S RMIEN(1)=RMIE22E
D WP^DIE(664.22,RMIEN(1)_","_RMIE2_",",9,,"RMPRTXTF","RMWPERR")
L -^RMPR(664.1,RMIE1)
I $D(RMERROR) S RMERR=1 G ERR
QUIT D POST^RMPR29U
EXIT K DA660,RESULTS,RMERROR,RMERR,RMIEN,RMIE1,RMIE2,RMIE22,RMIE22E,RMMAT,RMPRTXT,RMPRTXTF,RMQTY,RMMCOST,RMVC,RMVEN,RMUI,RMSN,RMPST,RMPRWO,RMWPERR
Q
K J,L,RESULTS(0),RMAMIS,RMDAT,RMIE60,RMIE68,RMNST
; Labor/Hours entry
AH(RMAED,RMIE1,RMIE2,RMLD,RMHR,RMPRT,RMTECH) ;
G AJ
EN2(RESULTS,RMAED,RMIE1,RMIE2,RMLD,RMHR,RMPRT,RMTECH,RMIE3,RMIE33) ;ENTRY FOR TECH/LABOR/HR
AJ ;
; If no Tech assigned then self assign here
I +$P(^RMPR(664.1,RMIE1,0),U,16)'>0 S $P(^(0),U,16)=DUZ,$P(^(0),U,17)="A",$P(^(7),U,1)=DT,$P(^(7),U,3)=DUZ
S X=RMLD D ^%DT S RMLD=Y K X,Y
I RMTECH="" S RMTECH=DUZ
S RESULTS(0)="",RMPRWO=RMIE2
K ^TMP($J)
S DA660=+$P(^RMPR(664.2,RMIE2,0),U,2)
S RMNST=$P(^RMPR(664.2,RMIE2,0),U,3)
I RMAED="E" G EDIT
S (RMIE3,RMIE33,J)="",RMFND=0
I RMAED="A" D
. F S J=$O(^RMPR(664.3,"B",RMLD,J)) Q:(J="")!(RMFND=1) D
.. I '$D(^RMPR(664.3,J,0)) Q
.. I $P(^RMPR(664.3,J,0),U,2)'=DA660 Q
.. S RMIE3=J
.. S:$D(^RMPR(664.3,RMIE3,1,"B",RMTECH)) RESULTS(0)="1^You already have Hours and Labor for this date. Please use the Detail/Edit instead of the Add Labor option.",RMFND=1 Q
I RMFND=1 Q
I RMAED="D" G DEL2
S (RMIE3,RMIE33,J)="",RMFND=0
F S J=$O(^RMPR(664.3,"B",RMLD,J)) Q:(J="")!(RMFND=1) D
. I '$D(^RMPR(664.3,J,0)) Q
. I $P(^RMPR(664.3,J,0),U,2)=DA660 S RMIE3=J,RMFND=1 Q
I RMFND=1 S:$D(^RMPR(664.3,RMIE3,1,"B",RMTECH)) RMIE33=$O(^RMPR(664.3,RMIE3,1,"B",RMTECH,0))
EDIT I RMIE3="" S RMIE3="+1"
I RMIE33="" S RMIE33="+2,"_RMIE3
E S RMIE33=RMIE33_","_RMIE3
S RMDAT(664.3,RMIE3_",",.01)=RMLD
S RMDAT(664.3,RMIE3_",",1)=DA660
S RMDAT(664.3,RMIE3_",",2)=RMNST
S RMDAT(664.33,RMIE33_",",.01)=RMTECH
S RMDAT(664.33,RMIE33_",",1)=RMHR
S RMDAT(664.33,RMIE33_",",2)=RMPRT
D UPDATE^DIE("","RMDAT","RMIEN","RMERROR")
L -^RMPR(664.1,RMIE1)
I $D(RMERROR) S RMERR=1 G ERR
;
W !!,"TO POST" D POST^RMPR29U
EXITL ;
K RMAED,RMIE2,RMLD,RMHR,RMPRT,RMTECH,RMWO,RM660,RMIE3,RMIE33,RMFND,RMIEN
Q
ERR S RESUTLS(0)=1_U_RMERROR("DIERR",1,"TEXT",1)
S ^TMP("SPS",1)=0_RMERROR("DIERR",1,"TEXT",1)
I $D(RMIE3) D EXITL
I $D(RMIE2) D EXIT
Q
DEL ;
S DA(1)=RMIE2,DA=RMIE22,DIK="^RMPR(664.2,"_DA(1)_",1," D ^DIK
K DA,DIK
L -^RMPR(664.1,RMIE1)
D POST^RMPR29U
Q
DEL2 ;
S (RMIE3,RMIE33,J)="",RMFND=0
F S J=$O(^RMPR(664.3,"B",RMLD,J)) Q:(J="")!(RMFND=1) D
. I '$D(^RMPR(664.3,J,0)) Q
. I $P(^RMPR(664.3,J,0),U,2)=DA660 S RMIE3=J,RMFND=1 Q
I RMFND=1 S:$D(^RMPR(664.3,RMIE3,1,"B",RMTECH)) RMIE33=$O(^(RMTECH,0))
E S RESULTS(0)="1^There was not a record for this Technician on this date." G EXITL
S DA(1)=RMIE3,DA=RMIE33,DIK="^RMPR(664.3,"_DA(1)_",1," D ^DIK
K DA,DIK
L -^RMPR(664.1,RMIE1)
D POST^RMPR29U
Q
UPD ;update file 668 with 2319 records
K DD,D0
S DA(1)=RMIE68
S DIC="^RMPR(668,"_DA(1)_","_"10,"
S DIC(0)="L",DLAYGO=668,X=RMIE60
D FILE^DICN
K DD,DO
S DA(1)=RMIE68
S DIC="^RMPR(668,"_DA(1)_","_"11,"
S X=RMAMIS
D FILE^DICN
K DIC,X,DLAYGO,D0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR29MG 4317 printed Dec 13, 2024@02:32:23 Page 2
RMPR29MG ;OI-HINES/SPS -OWL MATERIAL LABOR/HRS ENTER/EDIT RPC;12/27/2004
+1 ;;3.0;PROSTHETICS;**75**;Feb 09, 1996;Build 25
A1(RMAED,RMPRSITE,RMIE1,RMIE2,RMIE22,RMMAT,RMQTY,RMMCOST,RMVC,RMVEN,RMUI,RMSN,RMPST,RMPRTXT) ;roll and scroll entry point
+1 GOTO A2
+2 ;Material entry
EN(RESULTS,RMAED,RMIE1,RMIE2,RMIE22,RMMAT,RMQTY,RMMCOST,RMVC,RMVEN,RMUI,RMSN,RMPST,RMPRTXT) ;RPC entry point
A2 ;
+1 SET RESULTS(0)=""
SET RMPRWO=RMIE2
+2 KILL ^TMP($JOB)
+3 ;
+4 ; If no Tech assigned then self assign here
+5 IF +$PIECE(^RMPR(664.1,RMIE1,0),U,16)'>0
SET $PIECE(^(0),U,16)=DUZ
SET $PIECE(^(0),U,17)="A"
SET $PIECE(^(7),U,1)=DT
SET $PIECE(^(7),U,3)=DUZ
+6 IF RMAED="D"
DO DEL
QUIT
+7 ;
+8 SET DA660=+$PIECE(^RMPR(664.2,RMPRWO,0),U,2)
+9 SET RMERR=0
+10 IF RMIE22=""
SET RMIE22="+1,"_RMIE2
+11 IF '$TEST
SET RMIE22E=RMIE22
SET RMIE22=RMIE22_","_RMIE2
+12 SET RMDAT(664.22,RMIE22_",",.01)=RMMAT
+13 SET RMDAT(664.22,RMIE22_",",1)=RMQTY
+14 SET RMDAT(664.22,RMIE22_",",2)=RMMCOST
+15 SET RMDAT(664.22,RMIE22_",",3)=RMVC
+16 SET RMDAT(664.22,RMIE22_",",5)=RMVEN
+17 SET RMDAT(664.22,RMIE22_",",6)=RMUI
+18 SET RMDAT(664.22,RMIE22_",",7)=RMSN
+19 SET RMDAT(664.22,RMIE22_",",13)=RMPST
+20 DO UPDATE^DIE("","RMDAT","RMIEN","RMERROR")
+21 SET J=""
+22 FOR
SET J=$ORDER(RMPRTXT(J))
if J=""
QUIT
Begin DoDot:1
+23 SET L=J+1
SET RMPRTXTF(L)=RMPRTXT(J)
End DoDot:1
+24 IF '$DATA(RMIEN(1))
SET RMIEN(1)=RMIE22E
+25 DO WP^DIE(664.22,RMIEN(1)_","_RMIE2_",",9,,"RMPRTXTF","RMWPERR")
+26 LOCK -^RMPR(664.1,RMIE1)
+27 IF $DATA(RMERROR)
SET RMERR=1
GOTO ERR
QUIT DO POST^RMPR29U
EXIT KILL DA660,RESULTS,RMERROR,RMERR,RMIEN,RMIE1,RMIE2,RMIE22,RMIE22E,RMMAT,RMPRTXT,RMPRTXTF,RMQTY,RMMCOST,RMVC,RMVEN,RMUI,RMSN,RMPST,RMPRWO,RMWPERR
+1 QUIT
+2 KILL J,L,RESULTS(0),RMAMIS,RMDAT,RMIE60,RMIE68,RMNST
+3 ; Labor/Hours entry
AH(RMAED,RMIE1,RMIE2,RMLD,RMHR,RMPRT,RMTECH) ;
+1 GOTO AJ
EN2(RESULTS,RMAED,RMIE1,RMIE2,RMLD,RMHR,RMPRT,RMTECH,RMIE3,RMIE33) ;ENTRY FOR TECH/LABOR/HR
AJ ;
+1 ; If no Tech assigned then self assign here
+2 IF +$PIECE(^RMPR(664.1,RMIE1,0),U,16)'>0
SET $PIECE(^(0),U,16)=DUZ
SET $PIECE(^(0),U,17)="A"
SET $PIECE(^(7),U,1)=DT
SET $PIECE(^(7),U,3)=DUZ
+3 SET X=RMLD
DO ^%DT
SET RMLD=Y
KILL X,Y
+4 IF RMTECH=""
SET RMTECH=DUZ
+5 SET RESULTS(0)=""
SET RMPRWO=RMIE2
+6 KILL ^TMP($JOB)
+7 SET DA660=+$PIECE(^RMPR(664.2,RMIE2,0),U,2)
+8 SET RMNST=$PIECE(^RMPR(664.2,RMIE2,0),U,3)
+9 IF RMAED="E"
GOTO EDIT
+10 SET (RMIE3,RMIE33,J)=""
SET RMFND=0
+11 IF RMAED="A"
Begin DoDot:1
+12 FOR
SET J=$ORDER(^RMPR(664.3,"B",RMLD,J))
if (J="")!(RMFND=1)
QUIT
Begin DoDot:2
+13 IF '$DATA(^RMPR(664.3,J,0))
QUIT
+14 IF $PIECE(^RMPR(664.3,J,0),U,2)'=DA660
QUIT
+15 SET RMIE3=J
+16 if $DATA(^RMPR(664.3,RMIE3,1,"B",RMTECH))
SET RESULTS(0)="1^You already have Hours and Labor for this date. Please use the Detail/Edit instead of the Add Labor option."
SET RMFND=1
QUIT
End DoDot:2
End DoDot:1
+17 IF RMFND=1
QUIT
+18 IF RMAED="D"
GOTO DEL2
+19 SET (RMIE3,RMIE33,J)=""
SET RMFND=0
+20 FOR
SET J=$ORDER(^RMPR(664.3,"B",RMLD,J))
if (J="")!(RMFND=1)
QUIT
Begin DoDot:1
+21 IF '$DATA(^RMPR(664.3,J,0))
QUIT
+22 IF $PIECE(^RMPR(664.3,J,0),U,2)=DA660
SET RMIE3=J
SET RMFND=1
QUIT
End DoDot:1
+23 IF RMFND=1
if $DATA(^RMPR(664.3,RMIE3,1,"B",RMTECH))
SET RMIE33=$ORDER(^RMPR(664.3,RMIE3,1,"B",RMTECH,0))
EDIT IF RMIE3=""
SET RMIE3="+1"
+1 IF RMIE33=""
SET RMIE33="+2,"_RMIE3
+2 IF '$TEST
SET RMIE33=RMIE33_","_RMIE3
+3 SET RMDAT(664.3,RMIE3_",",.01)=RMLD
+4 SET RMDAT(664.3,RMIE3_",",1)=DA660
+5 SET RMDAT(664.3,RMIE3_",",2)=RMNST
+6 SET RMDAT(664.33,RMIE33_",",.01)=RMTECH
+7 SET RMDAT(664.33,RMIE33_",",1)=RMHR
+8 SET RMDAT(664.33,RMIE33_",",2)=RMPRT
+9 DO UPDATE^DIE("","RMDAT","RMIEN","RMERROR")
+10 LOCK -^RMPR(664.1,RMIE1)
+11 IF $DATA(RMERROR)
SET RMERR=1
GOTO ERR
+12 ;
+13 WRITE !!,"TO POST"
DO POST^RMPR29U
EXITL ;
+1 KILL RMAED,RMIE2,RMLD,RMHR,RMPRT,RMTECH,RMWO,RM660,RMIE3,RMIE33,RMFND,RMIEN
+2 QUIT
ERR SET RESUTLS(0)=1_U_RMERROR("DIERR",1,"TEXT",1)
+1 SET ^TMP("SPS",1)=0_RMERROR("DIERR",1,"TEXT",1)
+2 IF $DATA(RMIE3)
DO EXITL
+3 IF $DATA(RMIE2)
DO EXIT
+4 QUIT
DEL ;
+1 SET DA(1)=RMIE2
SET DA=RMIE22
SET DIK="^RMPR(664.2,"_DA(1)_",1,"
DO ^DIK
+2 KILL DA,DIK
+3 LOCK -^RMPR(664.1,RMIE1)
+4 DO POST^RMPR29U
+5 QUIT
DEL2 ;
+1 SET (RMIE3,RMIE33,J)=""
SET RMFND=0
+2 FOR
SET J=$ORDER(^RMPR(664.3,"B",RMLD,J))
if (J="")!(RMFND=1)
QUIT
Begin DoDot:1
+3 IF '$DATA(^RMPR(664.3,J,0))
QUIT
+4 IF $PIECE(^RMPR(664.3,J,0),U,2)=DA660
SET RMIE3=J
SET RMFND=1
QUIT
End DoDot:1
+5 IF RMFND=1
if $DATA(^RMPR(664.3,RMIE3,1,"B",RMTECH))
SET RMIE33=$ORDER(^(RMTECH,0))
+6 IF '$TEST
SET RESULTS(0)="1^There was not a record for this Technician on this date."
GOTO EXITL
+7 SET DA(1)=RMIE3
SET DA=RMIE33
SET DIK="^RMPR(664.3,"_DA(1)_",1,"
DO ^DIK
+8 KILL DA,DIK
+9 LOCK -^RMPR(664.1,RMIE1)
+10 DO POST^RMPR29U
+11 QUIT
UPD ;update file 668 with 2319 records
+1 KILL DD,D0
+2 SET DA(1)=RMIE68
+3 SET DIC="^RMPR(668,"_DA(1)_","_"10,"
+4 SET DIC(0)="L"
SET DLAYGO=668
SET X=RMIE60
+5 DO FILE^DICN
+6 KILL DD,DO
+7 SET DA(1)=RMIE68
+8 SET DIC="^RMPR(668,"_DA(1)_","_"11,"
+9 SET X=RMAMIS
+10 DO FILE^DICN
+11 KILL DIC,X,DLAYGO,D0
+12 QUIT
