| 1 | RMPRSIT ;PHX/HNC-SET UP SITE PARAMETERS ;8/29/1994
|
---|
| 2 | ;;3.0;PROSTHETICS;**46,90**;Feb 09, 1996
|
---|
| 3 | ;modified to accomodate a NULL chief signature block
|
---|
| 4 | 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
|
---|
| 5 | I '$D(^RMPR(669.9,RMPRSITE)) S RMPRSITE=$O(^RMPR(669.9,0))
|
---|
| 6 | D INF Q
|
---|
| 7 | DIV4 ;SET UP RMPR ARRAY FOR SINGLE AND MULT-DIVISIONAL SITES
|
---|
| 8 | ;RMPR("STA") IS SET TO A VALUE THAT POINTS INTO THE ENTRY IN FILE 669.9
|
---|
| 9 | ;VARIABLES REQUIRED: NOME
|
---|
| 10 | ;Q:$G(RMPRSITE)>0
|
---|
| 11 | S RMPRSITE=0 F RI=1:1 S RMPRSITE=$O(^RMPR(669.9,RMPRSITE)) Q:RMPRSITE'>0
|
---|
| 12 | I RI=2 S RMPRSITE=0,RMPRSITE=$O(^RMPR(669.9,RMPRSITE)) S RMPR("STA")=$P(^RMPR(669.9,RMPRSITE,0),U,2)
|
---|
| 13 | K DIC,Y S X=" ",DIC=669.9,DIC(0)="MZ" D ^DIC I +Y>0 S DIC("B")=Y(0,0)
|
---|
| 14 | 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
|
---|
| 15 | INF S RMPR("ADD")=$S($D(^RMPR(669.9,RMPRSITE,2)):$P(^RMPR(669.9,RMPRSITE,2),U,2),1:"")
|
---|
| 16 | 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:"")
|
---|
| 17 | 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)
|
---|
| 18 | S RMPR("CITY")=RMPR("CITY")_" "_$S($D(^RMPR(669.9,RMPRSITE,2)):$P(^RMPR(669.9,RMPRSITE,2),U,5),1:"")
|
---|
| 19 | ;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)
|
---|
| 20 | S RMPR("NAME")=$P(^RMPR(669.9,RMPRSITE,0),U,1)
|
---|
| 21 | S RMPR("SIG")=$P($G(^RMPR(669.9,RMPRSITE,2)),U,6),RMPR("SBT")=$P($G(^(2)),U,1)
|
---|
| 22 | S RMPR("STA")=$P(^RMPR(669.9,RMPRSITE,0),U,2)
|
---|
| 23 | S RMPR("PHONE")=$P(^RMPR(669.9,RMPRSITE,0),U,4)
|
---|
| 24 | S $P(RMPR("L"),"-",IOM)=""
|
---|
| 25 | K X,Y,I,DIC,RI Q
|
---|