source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR29MG.m@ 1806

Last change on this file since 1806 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.1 KB
Line 
1RMPR29MG ;OI-HINES/SPS -OWL MATERIAL LABOR/HRS ENTER/EDIT RPC;12/27/2004
2 ;;3.0;PROSTHETICS;**75**;Feb 09, 1996;Build 25
3A1(RMAED,RMPRSITE,RMIE1,RMIE2,RMIE22,RMMAT,RMQTY,RMMCOST,RMVC,RMVEN,RMUI,RMSN,RMPST,RMPRTXT) ;roll and scroll entry point
4 G A2
5 ;Material entry
6EN(RESULTS,RMAED,RMIE1,RMIE2,RMIE22,RMMAT,RMQTY,RMMCOST,RMVC,RMVEN,RMUI,RMSN,RMPST,RMPRTXT) ;RPC entry point
7A2 ;
8 S RESULTS(0)="",RMPRWO=RMIE2
9 K ^TMP($J)
10 ;
11 ; If no Tech assigned then self assign here
12 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
13 I RMAED="D" D DEL Q
14 ;
15 S DA660=+$P(^RMPR(664.2,RMPRWO,0),U,2)
16 S RMERR=0
17 I RMIE22="" S RMIE22="+1,"_RMIE2
18 E S RMIE22E=RMIE22,RMIE22=RMIE22_","_RMIE2
19 S RMDAT(664.22,RMIE22_",",.01)=RMMAT
20 S RMDAT(664.22,RMIE22_",",1)=RMQTY
21 S RMDAT(664.22,RMIE22_",",2)=RMMCOST
22 S RMDAT(664.22,RMIE22_",",3)=RMVC
23 S RMDAT(664.22,RMIE22_",",5)=RMVEN
24 S RMDAT(664.22,RMIE22_",",6)=RMUI
25 S RMDAT(664.22,RMIE22_",",7)=RMSN
26 S RMDAT(664.22,RMIE22_",",13)=RMPST
27 D UPDATE^DIE("","RMDAT","RMIEN","RMERROR")
28 S J=""
29 F S J=$O(RMPRTXT(J)) Q:J="" D
30 . S L=J+1,RMPRTXTF(L)=RMPRTXT(J)
31 I '$D(RMIEN(1)) S RMIEN(1)=RMIE22E
32 D WP^DIE(664.22,RMIEN(1)_","_RMIE2_",",9,,"RMPRTXTF","RMWPERR")
33 L -^RMPR(664.1,RMIE1)
34 I $D(RMERROR) S RMERR=1 G ERR
35QUIT D POST^RMPR29U
36EXIT K DA660,RESULTS,RMERROR,RMERR,RMIEN,RMIE1,RMIE2,RMIE22,RMIE22E,RMMAT,RMPRTXT,RMPRTXTF,RMQTY,RMMCOST,RMVC,RMVEN,RMUI,RMSN,RMPST,RMPRWO,RMWPERR
37 Q
38 K J,L,RESULTS(0),RMAMIS,RMDAT,RMIE60,RMIE68,RMNST
39 ; Labor/Hours entry
40AH(RMAED,RMIE1,RMIE2,RMLD,RMHR,RMPRT,RMTECH) ;
41 G AJ
42EN2(RESULTS,RMAED,RMIE1,RMIE2,RMLD,RMHR,RMPRT,RMTECH,RMIE3,RMIE33) ;ENTRY FOR TECH/LABOR/HR
43AJ ;
44 ; If no Tech assigned then self assign here
45 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
46 S X=RMLD D ^%DT S RMLD=Y K X,Y
47 I RMTECH="" S RMTECH=DUZ
48 S RESULTS(0)="",RMPRWO=RMIE2
49 K ^TMP($J)
50 S DA660=+$P(^RMPR(664.2,RMIE2,0),U,2)
51 S RMNST=$P(^RMPR(664.2,RMIE2,0),U,3)
52 I RMAED="E" G EDIT
53 S (RMIE3,RMIE33,J)="",RMFND=0
54 I RMAED="A" D
55 . F S J=$O(^RMPR(664.3,"B",RMLD,J)) Q:(J="")!(RMFND=1) D
56 .. I '$D(^RMPR(664.3,J,0)) Q
57 .. I $P(^RMPR(664.3,J,0),U,2)'=DA660 Q
58 .. S RMIE3=J
59 .. 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
60 I RMFND=1 Q
61 I RMAED="D" G DEL2
62 S (RMIE3,RMIE33,J)="",RMFND=0
63 F S J=$O(^RMPR(664.3,"B",RMLD,J)) Q:(J="")!(RMFND=1) D
64 . I '$D(^RMPR(664.3,J,0)) Q
65 . I $P(^RMPR(664.3,J,0),U,2)=DA660 S RMIE3=J,RMFND=1 Q
66 I RMFND=1 S:$D(^RMPR(664.3,RMIE3,1,"B",RMTECH)) RMIE33=$O(^RMPR(664.3,RMIE3,1,"B",RMTECH,0))
67EDIT I RMIE3="" S RMIE3="+1"
68 I RMIE33="" S RMIE33="+2,"_RMIE3
69 E S RMIE33=RMIE33_","_RMIE3
70 S RMDAT(664.3,RMIE3_",",.01)=RMLD
71 S RMDAT(664.3,RMIE3_",",1)=DA660
72 S RMDAT(664.3,RMIE3_",",2)=RMNST
73 S RMDAT(664.33,RMIE33_",",.01)=RMTECH
74 S RMDAT(664.33,RMIE33_",",1)=RMHR
75 S RMDAT(664.33,RMIE33_",",2)=RMPRT
76 D UPDATE^DIE("","RMDAT","RMIEN","RMERROR")
77 L -^RMPR(664.1,RMIE1)
78 I $D(RMERROR) S RMERR=1 G ERR
79 ;
80 W !!,"TO POST" D POST^RMPR29U
81EXITL ;
82 K RMAED,RMIE2,RMLD,RMHR,RMPRT,RMTECH,RMWO,RM660,RMIE3,RMIE33,RMFND,RMIEN
83 Q
84ERR S RESUTLS(0)=1_U_RMERROR("DIERR",1,"TEXT",1)
85 S ^TMP("SPS",1)=0_RMERROR("DIERR",1,"TEXT",1)
86 I $D(RMIE3) D EXITL
87 I $D(RMIE2) D EXIT
88 Q
89DEL ;
90 S DA(1)=RMIE2,DA=RMIE22,DIK="^RMPR(664.2,"_DA(1)_",1," D ^DIK
91 K DA,DIK
92 L -^RMPR(664.1,RMIE1)
93 D POST^RMPR29U
94 Q
95DEL2 ;
96 S (RMIE3,RMIE33,J)="",RMFND=0
97 F S J=$O(^RMPR(664.3,"B",RMLD,J)) Q:(J="")!(RMFND=1) D
98 . I '$D(^RMPR(664.3,J,0)) Q
99 . I $P(^RMPR(664.3,J,0),U,2)=DA660 S RMIE3=J,RMFND=1 Q
100 I RMFND=1 S:$D(^RMPR(664.3,RMIE3,1,"B",RMTECH)) RMIE33=$O(^(RMTECH,0))
101 E S RESULTS(0)="1^There was not a record for this Technician on this date." G EXITL
102 S DA(1)=RMIE3,DA=RMIE33,DIK="^RMPR(664.3,"_DA(1)_",1," D ^DIK
103 K DA,DIK
104 L -^RMPR(664.1,RMIE1)
105 D POST^RMPR29U
106 Q
107UPD ;update file 668 with 2319 records
108 K DD,D0
109 S DA(1)=RMIE68
110 S DIC="^RMPR(668,"_DA(1)_","_"10,"
111 S DIC(0)="L",DLAYGO=668,X=RMIE60
112 D FILE^DICN
113 K DD,DO
114 S DA(1)=RMIE68
115 S DIC="^RMPR(668,"_DA(1)_","_"11,"
116 S X=RMAMIS
117 D FILE^DICN
118 K DIC,X,DLAYGO,D0
119 Q
Note: See TracBrowser for help on using the repository browser.