- 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 Apr 23, 2025@18:46:23 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 ;
