RMPR9S8P ;HOIFO/SPS - GUI 2319 PRESCRIPTION INFO SCREEN 8 HOME OXYGEN
;;3.0;PROSTHETICS;**59**;Feb 09, 1996
; (IEN)=ien of file 660
;display detailed record
A1(IEN) G A2
EN(RESULTS,IEN) ;Broker
A2 ;
I '$D(^RMPR(660,IEN)) S RESULTS(0)="NOTHING TO REPORT" G EXIT
S RMPRDFN=$P(^RMPR(660,IEN,0),U,2)
S RMPODFN=RMPRDFN
D BPI,DPI
K PTI,I,RX,Y,DT1,DT2,TRX,IENS,DFN
Q
BPI ; Build pt info hdr
K PTI
; Name,SSN
S DFN=RMPODFN D DEM^VADPT
; Current Rx (IEN on ACT DATE)
S RX=$O(^RMPR(665,RMPODFN,"RMPOB"," "),-1)
I 'RX S RESULTS(0)="NOTHING TO REPORT" Q
S Y=$P(^RMPR(665,RMPODFN,"RMPOB",RX,0),U) X ^DD("DD") S DT1=Y
S Y=$P(^RMPR(665,RMPODFN,"RMPOB",RX,0),U,3) X ^DD("DD") S DT2=Y
S PTI(0)=RX
; Activation date
S PTI(1)=DT1
; Expiration Date:
S PTI(2)=DT2
; Rx Remarks
K TRX
S IENS=RX_","_RMPODFN_","
D GETS^DIQ(665.193,IENS,3,,"TRX")
S I=0 F S I=$O(TRX(665.193,IENS,3,I)) Q:I="" D
. S PTI(2+I)=TRX(665.193,IENS,3,I)
Q
DPI ; Display pt info hdr
S I="" F S I=$O(PTI(I)) Q:I="" S RESULTS(I)=PTI(I) ;W !,PTI(I)
Q
EXIT ;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR9S8P 1089 printed Dec 13, 2024@02:33:51 Page 2
RMPR9S8P ;HOIFO/SPS - GUI 2319 PRESCRIPTION INFO SCREEN 8 HOME OXYGEN
+1 ;;3.0;PROSTHETICS;**59**;Feb 09, 1996
+2 ; (IEN)=ien of file 660
+3 ;display detailed record
A1(IEN) GOTO A2
EN(RESULTS,IEN) ;Broker
A2 ;
+1 IF '$DATA(^RMPR(660,IEN))
SET RESULTS(0)="NOTHING TO REPORT"
GOTO EXIT
+2 SET RMPRDFN=$PIECE(^RMPR(660,IEN,0),U,2)
+3 SET RMPODFN=RMPRDFN
+4 DO BPI
DO DPI
+5 KILL PTI,I,RX,Y,DT1,DT2,TRX,IENS,DFN
+6 QUIT
BPI ; Build pt info hdr
+1 KILL PTI
+2 ; Name,SSN
+3 SET DFN=RMPODFN
DO DEM^VADPT
+4 ; Current Rx (IEN on ACT DATE)
+5 SET RX=$ORDER(^RMPR(665,RMPODFN,"RMPOB"," "),-1)
+6 IF 'RX
SET RESULTS(0)="NOTHING TO REPORT"
QUIT
+7 SET Y=$PIECE(^RMPR(665,RMPODFN,"RMPOB",RX,0),U)
XECUTE ^DD("DD")
SET DT1=Y
+8 SET Y=$PIECE(^RMPR(665,RMPODFN,"RMPOB",RX,0),U,3)
XECUTE ^DD("DD")
SET DT2=Y
+9 SET PTI(0)=RX
+10 ; Activation date
+11 SET PTI(1)=DT1
+12 ; Expiration Date:
+13 SET PTI(2)=DT2
+14 ; Rx Remarks
+15 KILL TRX
+16 SET IENS=RX_","_RMPODFN_","
+17 DO GETS^DIQ(665.193,IENS,3,,"TRX")
+18 SET I=0
FOR
SET I=$ORDER(TRX(665.193,IENS,3,I))
if I=""
QUIT
Begin DoDot:1
+19 SET PTI(2+I)=TRX(665.193,IENS,3,I)
End DoDot:1
+20 QUIT
DPI ; Display pt info hdr
+1 ;W !,PTI(I)
SET I=""
FOR
SET I=$ORDER(PTI(I))
if I=""
QUIT
SET RESULTS(I)=PTI(I)
+2 QUIT
EXIT ;
+1 QUIT
