- 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 Feb 18, 2025@23:58:52 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