RMPR210P ;RGB/MNTVBB - Resetting script expiration dates > year 2023 ; Nov 29, 2021@12:06
;;3.0;Prosthetics;**210**;Nov 29, 2021;Build 18
;;Per VA Directive 6402, this routine should not be modified.
;
;RMPR*3.0*210 Searches/lists for any prescription dates greater than
; year 2023 and resets expiration date to active date.
;
; Reference to $$PROD^XUPROD in ICR #4440
; Reference to ^XUSEC( in ICR #10076
; Reference to ^DPT( in ICR #10035
; Reference to ^XMD in ICR #10070
; Reference to ^XPDUTL in ICR #10141
;
Q
EN ;ENTRY POINT
D MES^XPDUTL("Reset per the search of Home Oxygen expiration dates >2023")
D MES^XPDUTL("that were set to future date to prolong script.")
N RMPRYR,RMPRYRX,RMPRIEN,RMPRSCRP,RMPRREC,RMPRSCDT,RMPRT1,RMPRT2,RMPRDT,RMPRSP,RMPRNM
N RMPRSITE,RMPRPROD,RMPRI,RMPRDT1,RMPRDT2,RMPRPRT,RMPRMES,RMPRNM
S U="^",RMPRYR=323,(RMPRIEN,RMPRT1,RMPRT2)=0,$P(RMPRSP," ",40)="",RMPRPRT=1
K ^TMP("RMPR210P",$J)
S ^XTMP("RMPR210P",0)=$$FMADD^XLFDT(DT,90)_"^"_DT
HOLOOP F S RMPRIEN=$O(^RMPR(665,RMPRIEN)) Q:'RMPRIEN D
. I $P($G(^DPT(RMPRIEN,.35)),U) Q
. I '$D(^RMPR(665,RMPRIEN,"RMPOA")) Q
. ;I $P($G(^RMPR(665,RMPRIEN,"RMPOA")),U,3) Q ;inactivation date check not checked
. S RMPRSCRP=0 F S RMPRSCRP=$O(^RMPR(665,RMPRIEN,"RMPOB",RMPRSCRP)) Q:'RMPRSCRP D
. . S RMPRREC=^RMPR(665,RMPRIEN,"RMPOB",RMPRSCRP,0) Q:'RMPRREC
. . S RMPRSCDT=$P(RMPRREC,U,3),RMPRYRX=$E(RMPRSCDT,1,3)
. . I RMPRYRX'>RMPRYR Q
. . S RMPRDT1=$$FMTE^XLFDT($P(RMPRREC,U),"5Z"),RMPRDT2=$$FMTE^XLFDT($P(RMPRREC,U,3),"5Z")
. . I $E(RMPRREC,1,3)>316 S ^TMP("RMPR210P",$J,"S",RMPRIEN,RMPRSCRP)=RMPRREC_"^^"_RMPRDT1_" / "_RMPRDT2,RMPRT2=RMPRT2+1 Q
. . S ^TMP("RMPR210P",$J,"C",RMPRIEN,RMPRSCRP)=RMPRREC_"^^"_RMPRDT1_" / "_RMPRDT2_U_RMPRDT1_" / "_RMPRDT1,RMPRT1=RMPRT1+1
. . S ^TMP("RMPR210P",$J,9,RMPRIEN,"RMPOB",RMPRSCRP,0)=RMPRREC
. . S RMPRDT=$P(RMPRREC,U),RMPRDT=$$FMTE^XLFDT(RMPRDT)
. . S DA=RMPRSCRP,DA(1)=RMPRIEN,DIE="^RMPR(665,"_RMPRIEN_",""RMPOB"",",DR="2///^S X=RMPRDT" D ^DIE
S ^TMP("RMPR210P",$J,"T",0)=RMPRT1_U_RMPRT2
QX ;REPORT
N RMPRSP,RMPRPROD,RMPRSITE,RMPRIEN,RMPRSCRP,RMPRREC
K DA,DR,DIE
S $P(RMPRSP," ",40)=""
S RMPRPROD=$$PROD^XUPROD(),RMPRSITE=$P($G(^RMPR(669.9,1,0)),U,1,2)
D BMES^XPDUTL("RESET EXPIRATION DATE >2023")
S RMPRMES="FOR "_$S(RMPRPROD=1:"PRODUCTION",1:"TEST")_" SITE: "_$P(RMPRSITE,U,2)_" - "_$P(RMPRSITE,U)_" ON "_$J($$FMTE^XLFDT(DT,"5Z"),10)
D BMES^XPDUTL(RMPRMES)
S RMPRMES="VETERAN NAME Before/After SCRIPT DATES (ACTIVE/EXPIRATION)"
D BMES^XPDUTL(RMPRMES)
S RMPRMES="============ =============================================" D MES^XPDUTL(RMPRMES)
S RMPRIEN=0
F S RMPRIEN=$O(^TMP("RMPR210P",$J,"C",RMPRIEN)),RMPRSCRP=0 Q:'RMPRIEN D
. D MES^XPDUTL(" ") S RMPRNM=$E($P(^DPT(RMPRIEN,0),U),1,25)
. F S RMPRSCRP=$O(^TMP("RMPR210P",$J,"C",RMPRIEN,RMPRSCRP)) Q:'RMPRSCRP D
. . S RMPRREC=^TMP("RMPR210P",$J,"C",RMPRIEN,RMPRSCRP)
. . S RMPRMES=$$LJSF(RMPRNM,28)_$P(RMPRREC,U,5)_" TO "_$P(RMPRREC,U,6) D MES^XPDUTL(RMPRMES)
S RMPRMES="*** TOTAL: "_$P(^TMP("RMPR210P",$J,"T",0),U) D BMES^XPDUTL(RMPRMES)
D BMES^XPDUTL("")
S RMPRMES="PATIENTS NEEDED TO BE EDITED MANUALLY:" D MES^XPDUTL(RMPRMES) S RMPRIEN=0
S RMPRMES="VETERAN NAME Before SCRIPT DATES (ACTIVE/EXPIRATION)" D BMES^XPDUTL(RMPRMES)
S RMPRMES="============ =============================================" D MES^XPDUTL(RMPRMES)
F S RMPRIEN=$O(^TMP("RMPR210P",$J,"S",RMPRIEN)),RMPRSCRP=0 Q:'RMPRIEN D
. D MES^XPDUTL("") S RMPRNM=$E($P(^DPT(RMPRIEN,0),U),1,25)
. F S RMPRSCRP=$O(^TMP("RMPR210P",$J,"S",RMPRIEN,RMPRSCRP)) Q:'RMPRSCRP D
. . S RMPRREC=^TMP("RMPR210P",$J,"S",RMPRIEN,RMPRSCRP)
. . S RMPRMES=$$LJSF(RMPRNM,28)_$P(RMPRREC,U,5) D MES^XPDUTL(RMPRMES)
D MES^XPDUTL("")
S RMPRMES="TOTAL: "_$P(^TMP("RMPR210P",$J,"T",0),U,2) D MES^XPDUTL(RMPRMES)
D:$G(RMPRPRT)=1 MSG
M ^XTMP("RMPR210P","C")=^TMP("RMPR210P",$J,"C") ;Set XTMP array for backup
M ^XTMP("RMPR210P","S")=^TMP("RMPR210P",$J,"S") ;Set XTMP array for backup
K ^TMP("RMPR210P",$J)
Q
EXIT ;
MSG N XMY,XMDUZ,XMSUB,XMTEXT,BMSG,RMPRIEN,RCCTR,RCIEN,DIFROM,RMPRMKY,RMPRSKY
S XMDUZ=.5
S XMSUB="**** RESET HO SCRIPT EXPIRATION DATES >2023 ***"
S BMSG(1)="The following Home Oxygen script expiration dates after 2023 are listed and"
S BMSG(2)="reset to the linked activity date."
S BMSG(3)=""
S BMSG(4)=$S(RMPRPROD=1:"PRODUCTION",1:"TEST")_" Site: "_$P(RMPRSITE,U,2)_" - "_$P(RMPRSITE,U)
S BMSG(5)=" "
S BMSG(6)="RESET >2023 EXPIRATION DATES TO BE SAME AS ACTIVITY DATE"
S BMSG(7)=" "
S BMSG(8)="VETERAN NAME Before/After SCRIPT DATES (ACTIVE/EXPIRATION)"
S BMSG(9)="============ ============================================="
M ^TMP("RMPR210P",$J,5)=BMSG
S RMPRIEN=0,RCCTR=9
F S RMPRIEN=$O(^TMP("RMPR210P",$J,"C",RMPRIEN)),RMPRSCRP=0 Q:'RMPRIEN D
. S:RCCTR>9 RCCTR=RCCTR+1,^TMP("RMPR210P",$J,5,RCCTR)=""
. F S RMPRSCRP=$O(^TMP("RMPR210P",$J,"C",RMPRIEN,RMPRSCRP)) Q:'RMPRSCRP D
. . S RMPRREC=^TMP("RMPR210P",$J,"C",RMPRIEN,RMPRSCRP),RMPRNM=$E($P(^DPT(RMPRIEN,0),U),1,25)
. . S RCCTR=RCCTR+1,^TMP("RMPR210P",$J,5,RCCTR)=RMPRNM_$E(RMPRSP,1,28-$L(RMPRNM))_$P(RMPRREC,U,5)_" TO "_$P(RMPRREC,U,6)
S RCCTR=RCCTR+1,^TMP("RMPR210P",$J,5,RCCTR)=""
S RCCTR=RCCTR+1,^TMP("RMPR210P",$J,5,RCCTR)="TOTAL: "_$P(^TMP("RMPR210P",$J,"T",0),U)
F RMPRI=1:1:4 S RCCTR=RCCTR+1,^TMP("RMPR210P",$J,5,RCCTR)=""
S RCCTR=RCCTR+1,^TMP("RMPR210P",$J,5,RCCTR)="PATIENTS NEED TO BE EDITED MANUALLY:"
S RCCTR=RCCTR+1,^TMP("RMPR210P",$J,5,RCCTR)=""
S RCCTR=RCCTR+1,^TMP("RMPR210P",$J,5,RCCTR)="VETERAN NAME Before SCRIPT DATES (ACTIVE/EXPIRATION)"
S RCCTR=RCCTR+1,^TMP("RMPR210P",$J,5,RCCTR)="============ ======================================="
S RCCTR=RCCTR+1,^TMP("RMPR210P",$J,5,RCCTR)=""
F S RMPRIEN=$O(^TMP("RMPR210P",$J,"S",RMPRIEN)),RMPRSCRP=0 Q:'RMPRIEN D
. F S RMPRSCRP=$O(^TMP("RMPR210P",$J,"S",RMPRIEN,RMPRSCRP)) Q:'RMPRSCRP D
. . S RMPRREC=^TMP("RMPR210P",$J,"S",RMPRIEN,RMPRSCRP),RMPRNM=$E($P(^DPT(RMPRIEN,0),U),1,25)
. . S RCCTR=RCCTR+1,^TMP("RMPR210P",$J,5,RCCTR)=RMPRNM_$E(RMPRSP,1,30-$L(RMPRNM))_" "_$P(RMPRREC,U,5)
F RMPRI=1,2 S RCCTR=RCCTR+1,^TMP("RMPR210P",$J,5,RCCTR)=""
S RCCTR=RCCTR+1,^TMP("RMPR210P",$J,5,RCCTR)="TOTAL: "_$P(^TMP("RMPR210P",$J,"T",0),U,2)
S XMTEXT="^TMP(""RMPR210P"""_","_$J_",5,"
S XMY(DUZ)="" ;Send mailman message to installer
S RMPRSKY=0 F S RMPRSKY=$O(^XUSEC("RMPRSUPERVISOR",RMPRSKY)) Q:'RMPRSKY S XMY(RMPRSKY)="" ;Send mailman message to holders of RMPRSUPERVISOR security key
S RMPRMKY=0 F S RMPRMKY=$O(^XUSEC("RMPRMANAGER",RMPRMKY)) Q:'RMPRMKY S XMY(RMPRMKY)="" ;Send mailman message to holders of RMPRMANAGER security key
MSG1 D ^XMD
Q
;
LJSF(X,Y) ;x left justified, y space filled
S X=X_$E(RMPRSP,1,30-$L(X))
Q X
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR210P 6953 printed Sep 23, 2025@20:08:02 Page 2
RMPR210P ;RGB/MNTVBB - Resetting script expiration dates > year 2023 ; Nov 29, 2021@12:06
+1 ;;3.0;Prosthetics;**210**;Nov 29, 2021;Build 18
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;RMPR*3.0*210 Searches/lists for any prescription dates greater than
+5 ; year 2023 and resets expiration date to active date.
+6 ;
+7 ; Reference to $$PROD^XUPROD in ICR #4440
+8 ; Reference to ^XUSEC( in ICR #10076
+9 ; Reference to ^DPT( in ICR #10035
+10 ; Reference to ^XMD in ICR #10070
+11 ; Reference to ^XPDUTL in ICR #10141
+12 ;
+13 QUIT
EN ;ENTRY POINT
+1 DO MES^XPDUTL("Reset per the search of Home Oxygen expiration dates >2023")
+2 DO MES^XPDUTL("that were set to future date to prolong script.")
+3 NEW RMPRYR,RMPRYRX,RMPRIEN,RMPRSCRP,RMPRREC,RMPRSCDT,RMPRT1,RMPRT2,RMPRDT,RMPRSP,RMPRNM
+4 NEW RMPRSITE,RMPRPROD,RMPRI,RMPRDT1,RMPRDT2,RMPRPRT,RMPRMES,RMPRNM
+5 SET U="^"
SET RMPRYR=323
SET (RMPRIEN,RMPRT1,RMPRT2)=0
SET $PIECE(RMPRSP," ",40)=""
SET RMPRPRT=1
+6 KILL ^TMP("RMPR210P",$JOB)
+7 SET ^XTMP("RMPR210P",0)=$$FMADD^XLFDT(DT,90)_"^"_DT
HOLOOP FOR
SET RMPRIEN=$ORDER(^RMPR(665,RMPRIEN))
if 'RMPRIEN
QUIT
Begin DoDot:1
+1 IF $PIECE($GET(^DPT(RMPRIEN,.35)),U)
QUIT
+2 IF '$DATA(^RMPR(665,RMPRIEN,"RMPOA"))
QUIT
+3 ;I $P($G(^RMPR(665,RMPRIEN,"RMPOA")),U,3) Q ;inactivation date check not checked
+4 SET RMPRSCRP=0
FOR
SET RMPRSCRP=$ORDER(^RMPR(665,RMPRIEN,"RMPOB",RMPRSCRP))
if 'RMPRSCRP
QUIT
Begin DoDot:2
+5 SET RMPRREC=^RMPR(665,RMPRIEN,"RMPOB",RMPRSCRP,0)
if 'RMPRREC
QUIT
+6 SET RMPRSCDT=$PIECE(RMPRREC,U,3)
SET RMPRYRX=$EXTRACT(RMPRSCDT,1,3)
+7 IF RMPRYRX'>RMPRYR
QUIT
+8 SET RMPRDT1=$$FMTE^XLFDT($PIECE(RMPRREC,U),"5Z")
SET RMPRDT2=$$FMTE^XLFDT($PIECE(RMPRREC,U,3),"5Z")
+9 IF $EXTRACT(RMPRREC,1,3)>316
SET ^TMP("RMPR210P",$JOB,"S",RMPRIEN,RMPRSCRP)=RMPRREC_"^^"_RMPRDT1_" / "_RMPRDT2
SET RMPRT2=RMPRT2+1
QUIT
+10 SET ^TMP("RMPR210P",$JOB,"C",RMPRIEN,RMPRSCRP)=RMPRREC_"^^"_RMPRDT1_" / "_RMPRDT2_U_RMPRDT1_" / "_RMPRDT1
SET RMPRT1=RMPRT1+1
+11 SET ^TMP("RMPR210P",$JOB,9,RMPRIEN,"RMPOB",RMPRSCRP,0)=RMPRREC
+12 SET RMPRDT=$PIECE(RMPRREC,U)
SET RMPRDT=$$FMTE^XLFDT(RMPRDT)
+13 SET DA=RMPRSCRP
SET DA(1)=RMPRIEN
SET DIE="^RMPR(665,"_RMPRIEN_",""RMPOB"","
SET DR="2///^S X=RMPRDT"
DO ^DIE
End DoDot:2
End DoDot:1
+14 SET ^TMP("RMPR210P",$JOB,"T",0)=RMPRT1_U_RMPRT2
QX ;REPORT
+1 NEW RMPRSP,RMPRPROD,RMPRSITE,RMPRIEN,RMPRSCRP,RMPRREC
+2 KILL DA,DR,DIE
+3 SET $PIECE(RMPRSP," ",40)=""
+4 SET RMPRPROD=$$PROD^XUPROD()
SET RMPRSITE=$PIECE($GET(^RMPR(669.9,1,0)),U,1,2)
+5 DO BMES^XPDUTL("RESET EXPIRATION DATE >2023")
+6 SET RMPRMES="FOR "_$SELECT(RMPRPROD=1:"PRODUCTION",1:"TEST")_" SITE: "_$PIECE(RMPRSITE,U,2)_" - "_$PIECE(RMPRSITE,U)_" ON "_$JUSTIFY($$FMTE^XLFDT(DT,"5Z"),10)
+7 DO BMES^XPDUTL(RMPRMES)
+8 SET RMPRMES="VETERAN NAME Before/After SCRIPT DATES (ACTIVE/EXPIRATION)"
+9 DO BMES^XPDUTL(RMPRMES)
+10 SET RMPRMES="============ ============================================="
DO MES^XPDUTL(RMPRMES)
+11 SET RMPRIEN=0
+12 FOR
SET RMPRIEN=$ORDER(^TMP("RMPR210P",$JOB,"C",RMPRIEN))
SET RMPRSCRP=0
if 'RMPRIEN
QUIT
Begin DoDot:1
+13 DO MES^XPDUTL(" ")
SET RMPRNM=$EXTRACT($PIECE(^DPT(RMPRIEN,0),U),1,25)
+14 FOR
SET RMPRSCRP=$ORDER(^TMP("RMPR210P",$JOB,"C",RMPRIEN,RMPRSCRP))
if 'RMPRSCRP
QUIT
Begin DoDot:2
+15 SET RMPRREC=^TMP("RMPR210P",$JOB,"C",RMPRIEN,RMPRSCRP)
+16 SET RMPRMES=$$LJSF(RMPRNM,28)_$PIECE(RMPRREC,U,5)_" TO "_$PIECE(RMPRREC,U,6)
DO MES^XPDUTL(RMPRMES)
End DoDot:2
End DoDot:1
+17 SET RMPRMES="*** TOTAL: "_$PIECE(^TMP("RMPR210P",$JOB,"T",0),U)
DO BMES^XPDUTL(RMPRMES)
+18 DO BMES^XPDUTL("")
+19 SET RMPRMES="PATIENTS NEEDED TO BE EDITED MANUALLY:"
DO MES^XPDUTL(RMPRMES)
SET RMPRIEN=0
+20 SET RMPRMES="VETERAN NAME Before SCRIPT DATES (ACTIVE/EXPIRATION)"
DO BMES^XPDUTL(RMPRMES)
+21 SET RMPRMES="============ ============================================="
DO MES^XPDUTL(RMPRMES)
+22 FOR
SET RMPRIEN=$ORDER(^TMP("RMPR210P",$JOB,"S",RMPRIEN))
SET RMPRSCRP=0
if 'RMPRIEN
QUIT
Begin DoDot:1
+23 DO MES^XPDUTL("")
SET RMPRNM=$EXTRACT($PIECE(^DPT(RMPRIEN,0),U),1,25)
+24 FOR
SET RMPRSCRP=$ORDER(^TMP("RMPR210P",$JOB,"S",RMPRIEN,RMPRSCRP))
if 'RMPRSCRP
QUIT
Begin DoDot:2
+25 SET RMPRREC=^TMP("RMPR210P",$JOB,"S",RMPRIEN,RMPRSCRP)
+26 SET RMPRMES=$$LJSF(RMPRNM,28)_$PIECE(RMPRREC,U,5)
DO MES^XPDUTL(RMPRMES)
End DoDot:2
End DoDot:1
+27 DO MES^XPDUTL("")
+28 SET RMPRMES="TOTAL: "_$PIECE(^TMP("RMPR210P",$JOB,"T",0),U,2)
DO MES^XPDUTL(RMPRMES)
+29 if $GET(RMPRPRT)=1
DO MSG
+30 ;Set XTMP array for backup
MERGE ^XTMP("RMPR210P","C")=^TMP("RMPR210P",$JOB,"C")
+31 ;Set XTMP array for backup
MERGE ^XTMP("RMPR210P","S")=^TMP("RMPR210P",$JOB,"S")
+32 KILL ^TMP("RMPR210P",$JOB)
+33 QUIT
EXIT ;
MSG NEW XMY,XMDUZ,XMSUB,XMTEXT,BMSG,RMPRIEN,RCCTR,RCIEN,DIFROM,RMPRMKY,RMPRSKY
+1 SET XMDUZ=.5
+2 SET XMSUB="**** RESET HO SCRIPT EXPIRATION DATES >2023 ***"
+3 SET BMSG(1)="The following Home Oxygen script expiration dates after 2023 are listed and"
+4 SET BMSG(2)="reset to the linked activity date."
+5 SET BMSG(3)=""
+6 SET BMSG(4)=$SELECT(RMPRPROD=1:"PRODUCTION",1:"TEST")_" Site: "_$PIECE(RMPRSITE,U,2)_" - "_$PIECE(RMPRSITE,U)
+7 SET BMSG(5)=" "
+8 SET BMSG(6)="RESET >2023 EXPIRATION DATES TO BE SAME AS ACTIVITY DATE"
+9 SET BMSG(7)=" "
+10 SET BMSG(8)="VETERAN NAME Before/After SCRIPT DATES (ACTIVE/EXPIRATION)"
+11 SET BMSG(9)="============ ============================================="
+12 MERGE ^TMP("RMPR210P",$JOB,5)=BMSG
+13 SET RMPRIEN=0
SET RCCTR=9
+14 FOR
SET RMPRIEN=$ORDER(^TMP("RMPR210P",$JOB,"C",RMPRIEN))
SET RMPRSCRP=0
if 'RMPRIEN
QUIT
Begin DoDot:1
+15 if RCCTR>9
SET RCCTR=RCCTR+1
SET ^TMP("RMPR210P",$JOB,5,RCCTR)=""
+16 FOR
SET RMPRSCRP=$ORDER(^TMP("RMPR210P",$JOB,"C",RMPRIEN,RMPRSCRP))
if 'RMPRSCRP
QUIT
Begin DoDot:2
+17 SET RMPRREC=^TMP("RMPR210P",$JOB,"C",RMPRIEN,RMPRSCRP)
SET RMPRNM=$EXTRACT($PIECE(^DPT(RMPRIEN,0),U),1,25)
+18 SET RCCTR=RCCTR+1
SET ^TMP("RMPR210P",$JOB,5,RCCTR)=RMPRNM_$EXTRACT(RMPRSP,1,28-$LENGTH(RMPRNM))_$PIECE(RMPRREC,U,5)_" TO "_$PIECE(RMPRREC,U,6)
End DoDot:2
End DoDot:1
+19 SET RCCTR=RCCTR+1
SET ^TMP("RMPR210P",$JOB,5,RCCTR)=""
+20 SET RCCTR=RCCTR+1
SET ^TMP("RMPR210P",$JOB,5,RCCTR)="TOTAL: "_$PIECE(^TMP("RMPR210P",$JOB,"T",0),U)
+21 FOR RMPRI=1:1:4
SET RCCTR=RCCTR+1
SET ^TMP("RMPR210P",$JOB,5,RCCTR)=""
+22 SET RCCTR=RCCTR+1
SET ^TMP("RMPR210P",$JOB,5,RCCTR)="PATIENTS NEED TO BE EDITED MANUALLY:"
+23 SET RCCTR=RCCTR+1
SET ^TMP("RMPR210P",$JOB,5,RCCTR)=""
+24 SET RCCTR=RCCTR+1
SET ^TMP("RMPR210P",$JOB,5,RCCTR)="VETERAN NAME Before SCRIPT DATES (ACTIVE/EXPIRATION)"
+25 SET RCCTR=RCCTR+1
SET ^TMP("RMPR210P",$JOB,5,RCCTR)="============ ======================================="
+26 SET RCCTR=RCCTR+1
SET ^TMP("RMPR210P",$JOB,5,RCCTR)=""
+27 FOR
SET RMPRIEN=$ORDER(^TMP("RMPR210P",$JOB,"S",RMPRIEN))
SET RMPRSCRP=0
if 'RMPRIEN
QUIT
Begin DoDot:1
+28 FOR
SET RMPRSCRP=$ORDER(^TMP("RMPR210P",$JOB,"S",RMPRIEN,RMPRSCRP))
if 'RMPRSCRP
QUIT
Begin DoDot:2
+29 SET RMPRREC=^TMP("RMPR210P",$JOB,"S",RMPRIEN,RMPRSCRP)
SET RMPRNM=$EXTRACT($PIECE(^DPT(RMPRIEN,0),U),1,25)
+30 SET RCCTR=RCCTR+1
SET ^TMP("RMPR210P",$JOB,5,RCCTR)=RMPRNM_$EXTRACT(RMPRSP,1,30-$LENGTH(RMPRNM))_" "_$PIECE(RMPRREC,U,5)
End DoDot:2
End DoDot:1
+31 FOR RMPRI=1,2
SET RCCTR=RCCTR+1
SET ^TMP("RMPR210P",$JOB,5,RCCTR)=""
+32 SET RCCTR=RCCTR+1
SET ^TMP("RMPR210P",$JOB,5,RCCTR)="TOTAL: "_$PIECE(^TMP("RMPR210P",$JOB,"T",0),U,2)
+33 SET XMTEXT="^TMP(""RMPR210P"""_","_$JOB_",5,"
+34 ;Send mailman message to installer
SET XMY(DUZ)=""
+35 ;Send mailman message to holders of RMPRSUPERVISOR security key
SET RMPRSKY=0
FOR
SET RMPRSKY=$ORDER(^XUSEC("RMPRSUPERVISOR",RMPRSKY))
if 'RMPRSKY
QUIT
SET XMY(RMPRSKY)=""
+36 ;Send mailman message to holders of RMPRMANAGER security key
SET RMPRMKY=0
FOR
SET RMPRMKY=$ORDER(^XUSEC("RMPRMANAGER",RMPRMKY))
if 'RMPRMKY
QUIT
SET XMY(RMPRMKY)=""
MSG1 DO ^XMD
+1 QUIT
+2 ;
LJSF(X,Y) ;x left justified, y space filled
+1 SET X=X_$EXTRACT(RMPRSP,1,30-$LENGTH(X))
+2 QUIT X
+3 ;
