VistA-FOIAVistA/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR29MG.m

120 lines
4.1 KiB
Mathematica

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