RMPOUTL0 ;NG/CAP - HOME OXYGEN FUNCTIONS ;7/24/98
;;3.0;PROSTHETICS;**29,44**;Feb 09, 1996
;
SITE(X) ;Set up RMPO site parameters.
D HOSITE
Q
;
HOSITE ;New entry point that should replace SITE(X).
;Initialize device.
D HOME^%ZIS
S QUIT=0
;Set up site variables.
;N RMPRSITE,RMPR
K RMPO
D DIV4^RMPRSIT
I $D(Y),(Y<0) S QUIT=1 Q
I '$G(RMPRSITE) S QUIT=1 Q
S RMPRS=$P($G(^RMPR(669.9,RMPRSITE,4)),U,1)
I '$G(RMPRS) W !,"***The IFCAP SITE is not defined, please check file #669.9.***" S QUIT=1 Q
I $G(RMPRS),'$D(^PRC(411,RMPRS,0)) W !,"***The IFCAP SITE is not defined, please check file #411.***" S QUIT=1 Q
M RMPO=RMPR
S RMPOSITE=RMPO("STA")
S (RMPOXITE,RMPOREC)=RMPRSITE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPOUTL0 715 printed Oct 16, 2024@18:32:14 Page 2
RMPOUTL0 ;NG/CAP - HOME OXYGEN FUNCTIONS ;7/24/98
+1 ;;3.0;PROSTHETICS;**29,44**;Feb 09, 1996
+2 ;
SITE(X) ;Set up RMPO site parameters.
+1 DO HOSITE
+2 QUIT
+3 ;
HOSITE ;New entry point that should replace SITE(X).
+1 ;Initialize device.
+2 DO HOME^%ZIS
+3 SET QUIT=0
+4 ;Set up site variables.
+5 ;N RMPRSITE,RMPR
+6 KILL RMPO
+7 DO DIV4^RMPRSIT
+8 IF $DATA(Y)
IF (Y<0)
SET QUIT=1
QUIT
+9 IF '$GET(RMPRSITE)
SET QUIT=1
QUIT
+10 SET RMPRS=$PIECE($GET(^RMPR(669.9,RMPRSITE,4)),U,1)
+11 IF '$GET(RMPRS)
WRITE !,"***The IFCAP SITE is not defined, please check file #669.9.***"
SET QUIT=1
QUIT
+12 IF $GET(RMPRS)
IF '$DATA(^PRC(411,RMPRS,0))
WRITE !,"***The IFCAP SITE is not defined, please check file #411.***"
SET QUIT=1
QUIT
+13 MERGE RMPO=RMPR
+14 SET RMPOSITE=RMPO("STA")
+15 SET (RMPOXITE,RMPOREC)=RMPRSITE
+16 QUIT
