Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPR29MG

RMPR29MG.m

Go to the documentation of this file.
  1. RMPR29MG ;OI-HINES/SPS -OWL MATERIAL LABOR/HRS ENTER/EDIT RPC;12/27/2004
  1. ;;3.0;PROSTHETICS;**75**;Feb 09, 1996;Build 25
  1. A1(RMAED,RMPRSITE,RMIE1,RMIE2,RMIE22,RMMAT,RMQTY,RMMCOST,RMVC,RMVEN,RMUI,RMSN,RMPST,RMPRTXT) ;roll and scroll entry point
  1. G A2
  1. ;Material entry
  1. EN(RESULTS,RMAED,RMIE1,RMIE2,RMIE22,RMMAT,RMQTY,RMMCOST,RMVC,RMVEN,RMUI,RMSN,RMPST,RMPRTXT) ;RPC entry point
  1. A2 ;
  1. S RESULTS(0)="",RMPRWO=RMIE2
  1. K ^TMP($J)
  1. ;
  1. ; If no Tech assigned then self assign here
  1. 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
  1. I RMAED="D" D DEL Q
  1. ;
  1. S DA660=+$P(^RMPR(664.2,RMPRWO,0),U,2)
  1. S RMERR=0
  1. I RMIE22="" S RMIE22="+1,"_RMIE2
  1. E S RMIE22E=RMIE22,RMIE22=RMIE22_","_RMIE2
  1. S RMDAT(664.22,RMIE22_",",.01)=RMMAT
  1. S RMDAT(664.22,RMIE22_",",1)=RMQTY
  1. S RMDAT(664.22,RMIE22_",",2)=RMMCOST
  1. S RMDAT(664.22,RMIE22_",",3)=RMVC
  1. S RMDAT(664.22,RMIE22_",",5)=RMVEN
  1. S RMDAT(664.22,RMIE22_",",6)=RMUI
  1. S RMDAT(664.22,RMIE22_",",7)=RMSN
  1. S RMDAT(664.22,RMIE22_",",13)=RMPST
  1. D UPDATE^DIE("","RMDAT","RMIEN","RMERROR")
  1. S J=""
  1. F S J=$O(RMPRTXT(J)) Q:J="" D
  1. . S L=J+1,RMPRTXTF(L)=RMPRTXT(J)
  1. I '$D(RMIEN(1)) S RMIEN(1)=RMIE22E
  1. D WP^DIE(664.22,RMIEN(1)_","_RMIE2_",",9,,"RMPRTXTF","RMWPERR")
  1. L -^RMPR(664.1,RMIE1)
  1. I $D(RMERROR) S RMERR=1 G ERR
  1. QUIT D POST^RMPR29U
  1. EXIT K DA660,RESULTS,RMERROR,RMERR,RMIEN,RMIE1,RMIE2,RMIE22,RMIE22E,RMMAT,RMPRTXT,RMPRTXTF,RMQTY,RMMCOST,RMVC,RMVEN,RMUI,RMSN,RMPST,RMPRWO,RMWPERR
  1. Q
  1. K J,L,RESULTS(0),RMAMIS,RMDAT,RMIE60,RMIE68,RMNST
  1. ; Labor/Hours entry
  1. AH(RMAED,RMIE1,RMIE2,RMLD,RMHR,RMPRT,RMTECH) ;
  1. G AJ
  1. EN2(RESULTS,RMAED,RMIE1,RMIE2,RMLD,RMHR,RMPRT,RMTECH,RMIE3,RMIE33) ;ENTRY FOR TECH/LABOR/HR
  1. AJ ;
  1. ; If no Tech assigned then self assign here
  1. 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
  1. S X=RMLD D ^%DT S RMLD=Y K X,Y
  1. I RMTECH="" S RMTECH=DUZ
  1. S RESULTS(0)="",RMPRWO=RMIE2
  1. K ^TMP($J)
  1. S DA660=+$P(^RMPR(664.2,RMIE2,0),U,2)
  1. S RMNST=$P(^RMPR(664.2,RMIE2,0),U,3)
  1. I RMAED="E" G EDIT
  1. S (RMIE3,RMIE33,J)="",RMFND=0
  1. I RMAED="A" D
  1. . F S J=$O(^RMPR(664.3,"B",RMLD,J)) Q:(J="")!(RMFND=1) D
  1. .. I '$D(^RMPR(664.3,J,0)) Q
  1. .. I $P(^RMPR(664.3,J,0),U,2)'=DA660 Q
  1. .. S RMIE3=J
  1. .. 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
  1. I RMFND=1 Q
  1. I RMAED="D" G DEL2
  1. S (RMIE3,RMIE33,J)="",RMFND=0
  1. F S J=$O(^RMPR(664.3,"B",RMLD,J)) Q:(J="")!(RMFND=1) D
  1. . I '$D(^RMPR(664.3,J,0)) Q
  1. . I $P(^RMPR(664.3,J,0),U,2)=DA660 S RMIE3=J,RMFND=1 Q
  1. I RMFND=1 S:$D(^RMPR(664.3,RMIE3,1,"B",RMTECH)) RMIE33=$O(^RMPR(664.3,RMIE3,1,"B",RMTECH,0))
  1. EDIT I RMIE3="" S RMIE3="+1"
  1. I RMIE33="" S RMIE33="+2,"_RMIE3
  1. E S RMIE33=RMIE33_","_RMIE3
  1. S RMDAT(664.3,RMIE3_",",.01)=RMLD
  1. S RMDAT(664.3,RMIE3_",",1)=DA660
  1. S RMDAT(664.3,RMIE3_",",2)=RMNST
  1. S RMDAT(664.33,RMIE33_",",.01)=RMTECH
  1. S RMDAT(664.33,RMIE33_",",1)=RMHR
  1. S RMDAT(664.33,RMIE33_",",2)=RMPRT
  1. D UPDATE^DIE("","RMDAT","RMIEN","RMERROR")
  1. L -^RMPR(664.1,RMIE1)
  1. I $D(RMERROR) S RMERR=1 G ERR
  1. ;
  1. W !!,"TO POST" D POST^RMPR29U
  1. EXITL ;
  1. K RMAED,RMIE2,RMLD,RMHR,RMPRT,RMTECH,RMWO,RM660,RMIE3,RMIE33,RMFND,RMIEN
  1. Q
  1. ERR S RESUTLS(0)=1_U_RMERROR("DIERR",1,"TEXT",1)
  1. S ^TMP("SPS",1)=0_RMERROR("DIERR",1,"TEXT",1)
  1. I $D(RMIE3) D EXITL
  1. I $D(RMIE2) D EXIT
  1. Q
  1. DEL ;
  1. S DA(1)=RMIE2,DA=RMIE22,DIK="^RMPR(664.2,"_DA(1)_",1," D ^DIK
  1. K DA,DIK
  1. L -^RMPR(664.1,RMIE1)
  1. D POST^RMPR29U
  1. Q
  1. DEL2 ;
  1. S (RMIE3,RMIE33,J)="",RMFND=0
  1. F S J=$O(^RMPR(664.3,"B",RMLD,J)) Q:(J="")!(RMFND=1) D
  1. . I '$D(^RMPR(664.3,J,0)) Q
  1. . I $P(^RMPR(664.3,J,0),U,2)=DA660 S RMIE3=J,RMFND=1 Q
  1. I RMFND=1 S:$D(^RMPR(664.3,RMIE3,1,"B",RMTECH)) RMIE33=$O(^(RMTECH,0))
  1. E S RESULTS(0)="1^There was not a record for this Technician on this date." G EXITL
  1. S DA(1)=RMIE3,DA=RMIE33,DIK="^RMPR(664.3,"_DA(1)_",1," D ^DIK
  1. K DA,DIK
  1. L -^RMPR(664.1,RMIE1)
  1. D POST^RMPR29U
  1. Q
  1. UPD ;update file 668 with 2319 records
  1. K DD,D0
  1. S DA(1)=RMIE68
  1. S DIC="^RMPR(668,"_DA(1)_","_"10,"
  1. S DIC(0)="L",DLAYGO=668,X=RMIE60
  1. D FILE^DICN
  1. K DD,DO
  1. S DA(1)=RMIE68
  1. S DIC="^RMPR(668,"_DA(1)_","_"11,"
  1. S X=RMAMIS
  1. D FILE^DICN
  1. K DIC,X,DLAYGO,D0
  1. Q