source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR29MG.m@ 1154

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