RMPRSIT.m

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

 I '$D(RMPRSITE) S X=" ",DIC=669.9,DIC(0)="ZM" D ^DIC S:+Y>0 RMPRSITE=+Y S:+Y'>0 RMPRSITE=$O(^RMPR(669.9,0)) Q:+RMPRSITE'>0  D INF Q

 I '$D(^RMPR(669.9,RMPRSITE)) S RMPRSITE=$O(^RMPR(669.9,0))

 D INF Q

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

 S RMPRSITE=0 F RI=1:1 S RMPRSITE=$O(^RMPR(669.9,RMPRSITE)) Q:RMPRSITE'>0

 I RI=2 S RMPRSITE=0,RMPRSITE=$O(^RMPR(669.9,RMPRSITE)) S RMPR("STA")=$P(^RMPR(669.9,RMPRSITE,0),U,2)

 K DIC,Y S X=" ",DIC=669.9,DIC(0)="MZ" D ^DIC I +Y>0 S DIC("B")=Y(0,0)

 I RI>2 K RMPRSITE S 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:"""")" D ^DIC Q:+Y<0  S RMPRSITE=+Y

INF S RMPR("ADD")=$S($D(^RMPR(669.9,RMPRSITE,2)):$P(^RMPR(669.9,RMPRSITE,2),U,2),1:"")

 S RMPR("CITY")=$S($D(^RMPR(669.9,RMPRSITE,2)):$P(^RMPR(669.9,RMPRSITE,2),U,3)_", "_$S(+$P(^(2),U,4)>0:$P(^DIC(5,$P(^(2),U,4),0),U,2),1:""),1:"")

 I $D(^RMPR(669.9,RMPRSITE,2)) I $P(^RMPR(669.9,RMPRSITE,2),U,4)'>0 S RMPR("CITY")=$P(^DIC(4,$P(^RMPR(669.9,RMPRSITE,0),U,2),0),U,1)

 S RMPR("CITY")=RMPR("CITY")_"  "_$S($D(^RMPR(669.9,RMPRSITE,2)):$P(^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)

 S RMPR("NAME")=$P(^RMPR(669.9,RMPRSITE,0),U,1)

 S RMPR("SIG")=$P($G(^RMPR(669.9,RMPRSITE,2)),U,6),RMPR("SBT")=$P($G(^(2)),U,1)

 S RMPR("STA")=$P(^RMPR(669.9,RMPRSITE,0),U,2)

 S RMPR("PHONE")=$P(^RMPR(669.9,RMPRSITE,0),U,4)

 S $P(RMPR("L"),"-",IOM)=""

 K X,Y,I,DIC,RI Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RMPRSIT   1859     printed  Apr 09, 2024@21:38:11                                                                                                                                                                                                     Page 2

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

               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

           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

               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        SET $PIECE(RMPR("L"),"-",IOM)=""

 +10       KILL X,Y,I,DIC,RI

           QUIT