RMPV0RMPRSIT ; OIT/JDA - Adapted from RMPRSIT; Dec 01, 2024@21:44:42
;;1.0;PROSTHETICS VISION 4 SIGHT II;**2**;Jan 31, 2025;Build 38
;Per VHA Directive 10-93-142, this routine should not be modified.
;
; Reference to file #5 supported by ICR #10056
; Reference to file #669.9 supported by ICR #6542
;
RMPRSIT ;PHX/HNC-SET UP SITE PARAMETERS ;8/29/1994
;;3.0;PROSTHETICS;**46,90**;Feb 09, 1996
;modified to accomodate a NULL chief signature block
If '$DATA(RMPRSITE) Set X=" ",DIC=669.9,DIC(0)="ZM" Do %DIC^RMPVFM Set:+Y>0 RMPRSITE=+Y Set:+Y'>0 RMPRSITE=$ORDER(^RMPR(669.9,0)) Quit:+RMPRSITE'>0 Do INF Quit
If '$DATA(^RMPR(669.9,RMPRSITE)) Set RMPRSITE=$ORDER(^RMPR(669.9,0))
Do INF Quit
DIV4 ;SET UP RMPR ARRAY FOR SINGLE AND MULT-DIVISIONAL SITES
;RMPR("STA") IS SET TO A VALUE THAT POINTS INTO THE ENTRY IN FILE 669.9
;VARIABLES REQUIRED: NOME
;Q:$G(RMPRSITE)>0
Set RMPRSITE=0 For RI=1:1 Set RMPRSITE=$ORDER(^RMPR(669.9,RMPRSITE)) Quit:RMPRSITE'>0
If RI=2 Set RMPRSITE=0,RMPRSITE=$ORDER(^RMPR(669.9,RMPRSITE)) Set RMPR("STA")=$PIECE(^RMPR(669.9,RMPRSITE,0),U,2)
Kill DIC,Y Set X=" ",DIC=669.9,DIC(0)="MZ" Do %DIC^RMPVFM If +Y>0 Set DIC("B")=Y(0,0)
If RI>2 Kill RMPRSITE Set DIC="^RMPR(669.9,",DIC(0)="AEQM",DIC("A")="SITE: ",DIC("W")="W ?50,$S($D(^DIC(4,$P(^(0),U,2),99)):$P(^(99),U),1:"""")" Do %DIC^RMPVFM Quit:+Y<0 Set RMPRSITE=+Y
INF Set RMPR("ADD")=$SELECT($DATA(^RMPR(669.9,RMPRSITE,2)):$PIECE(^RMPR(669.9,RMPRSITE,2),U,2),1:"")
Set RMPR("CITY")=$SELECT($DATA(^RMPR(669.9,RMPRSITE,2)):$PIECE(^RMPR(669.9,RMPRSITE,2),U,3)_", "_$SELECT(+$PIECE(^(2),U,4)>0:$PIECE(^DIC(5,$PIECE(^(2),U,4),0),U,2),1:""),1:"")
If $DATA(^RMPR(669.9,RMPRSITE,2)) If $PIECE(^RMPR(669.9,RMPRSITE,2),U,4)'>0 Set RMPR("CITY")=$PIECE(^DIC(4,$PIECE(^RMPR(669.9,RMPRSITE,0),U,2),0),U,1)
Set RMPR("CITY")=RMPR("CITY")_" "_$SELECT($DATA(^RMPR(669.9,RMPRSITE,2)):$PIECE(^RMPR(669.9,RMPRSITE,2),U,5),1:"")
;S RMPR("NAME")=$P(^RMPR(669.9,RMPRSITE,0),U,1) I $D(^RMPR(669.9,RMPRSITE,2)) S RMPR("SIG")=$P(^RMPR(669.9,RMPRSITE,2),U,6),RMPR("SBT")=$P(^(2),U,1)
Set RMPR("NAME")=$PIECE(^RMPR(669.9,RMPRSITE,0),U,1)
Set RMPR("SIG")=$PIECE($GET(^RMPR(669.9,RMPRSITE,2)),U,6),RMPR("SBT")=$PIECE($GET(^(2)),U,1)
Set RMPR("STA")=$PIECE(^RMPR(669.9,RMPRSITE,0),U,2)
Set RMPR("PHONE")=$PIECE(^RMPR(669.9,RMPRSITE,0),U,4)
; S $P(RMPR("L"),"-",IOM)=""
Kill X,Y,I,DIC,RI Quit
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPV0RMPRSIT 2398 printed May 25, 2026@12:51 Page 2
RMPV0RMPRSIT ; OIT/JDA - Adapted from RMPRSIT; Dec 01, 2024@21:44:42
+1 ;;1.0;PROSTHETICS VISION 4 SIGHT II;**2**;Jan 31, 2025;Build 38
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; Reference to file #5 supported by ICR #10056
+5 ; Reference to file #669.9 supported by ICR #6542
+6 ;
RMPRSIT ;PHX/HNC-SET UP SITE PARAMETERS ;8/29/1994
+1 ;;3.0;PROSTHETICS;**46,90**;Feb 09, 1996
+2 ;modified to accomodate a NULL chief signature block
+3 IF '$DATA(RMPRSITE)
SET X=" "
SET DIC=669.9
SET DIC(0)="ZM"
DO %DIC^RMPVFM
if +Y>0
SET RMPRSITE=+Y
if +Y'>0
SET RMPRSITE=$ORDER(^RMPR(669.9,0))
if +RMPRSITE'>0
QUIT
DO INF
QUIT
+4 IF '$DATA(^RMPR(669.9,RMPRSITE))
SET RMPRSITE=$ORDER(^RMPR(669.9,0))
+5 DO INF
QUIT
DIV4 ;SET UP RMPR ARRAY FOR SINGLE AND MULT-DIVISIONAL SITES
+1 ;RMPR("STA") IS SET TO A VALUE THAT POINTS INTO THE ENTRY IN FILE 669.9
+2 ;VARIABLES REQUIRED: NOME
+3 ;Q:$G(RMPRSITE)>0
+4 SET RMPRSITE=0
FOR RI=1:1
SET RMPRSITE=$ORDER(^RMPR(669.9,RMPRSITE))
if RMPRSITE'>0
QUIT
+5 IF RI=2
SET RMPRSITE=0
SET RMPRSITE=$ORDER(^RMPR(669.9,RMPRSITE))
SET RMPR("STA")=$PIECE(^RMPR(669.9,RMPRSITE,0),U,2)
+6 KILL DIC,Y
SET X=" "
SET DIC=669.9
SET DIC(0)="MZ"
DO %DIC^RMPVFM
IF +Y>0
SET DIC("B")=Y(0,0)
+7 IF RI>2
KILL RMPRSITE
SET DIC="^RMPR(669.9,"
SET DIC(0)="AEQM"
SET DIC("A")="SITE: "
SET DIC("W")="W ?50,$S($D(^DIC(4,$P(^(0),U,2),99)):$P(^(99),U),1:"""")"
DO %DIC^RMPVFM
if +Y<0
QUIT
SET RMPRSITE=+Y
INF SET RMPR("ADD")=$SELECT($DATA(^RMPR(669.9,RMPRSITE,2)):$PIECE(^RMPR(669.9,RMPRSITE,2),U,2),1:"")
+1 SET RMPR("CITY")=$SELECT($DATA(^RMPR(669.9,RMPRSITE,2)):$PIECE(^RMPR(669.9,RMPRSITE,2),U,3)_", "_$SELECT(+$PIECE(^(2),U,4)>0:$PIECE(^DIC(5,$PIECE(^(2),U,4),0),U,2),1:""),1:"")
+2 IF $DATA(^RMPR(669.9,RMPRSITE,2))
IF $PIECE(^RMPR(669.9,RMPRSITE,2),U,4)'>0
SET RMPR("CITY")=$PIECE(^DIC(4,$PIECE(^RMPR(669.9,RMPRSITE,0),U,2),0),U,1)
+3 SET RMPR("CITY")=RMPR("CITY")_" "_$SELECT($DATA(^RMPR(669.9,RMPRSITE,2)):$PIECE(^RMPR(669.9,RMPRSITE,2),U,5),1:"")
+4 ;S RMPR("NAME")=$P(^RMPR(669.9,RMPRSITE,0),U,1) I $D(^RMPR(669.9,RMPRSITE,2)) S RMPR("SIG")=$P(^RMPR(669.9,RMPRSITE,2),U,6),RMPR("SBT")=$P(^(2),U,1)
+5 SET RMPR("NAME")=$PIECE(^RMPR(669.9,RMPRSITE,0),U,1)
+6 SET RMPR("SIG")=$PIECE($GET(^RMPR(669.9,RMPRSITE,2)),U,6)
SET RMPR("SBT")=$PIECE($GET(^(2)),U,1)
+7 SET RMPR("STA")=$PIECE(^RMPR(669.9,RMPRSITE,0),U,2)
+8 SET RMPR("PHONE")=$PIECE(^RMPR(669.9,RMPRSITE,0),U,4)
+9 ; S $P(RMPR("L"),"-",IOM)=""
+10 KILL X,Y,I,DIC,RI
QUIT
