RMPR9S8P.m

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 ---RMPR9S8P   1089     printed  Apr 23, 2025@18:48:21                                                                                                                                                                                                    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