RMPRUTL2 ;PHX/HPL-Patient Letter Date look-up in chronological order ;05/22/1995
;;3.0;PROSTHETICS;;Feb 09, 1996
EN1 ;entry point to ask patient
I '$D(RMPR) D DIV4^RMPRSIT
D GETPAT^RMPRUTIL Q:'$D(RMPRDFN)
EN ;entry point pass RMPRDFN
;return RMPRPRIN as ien of 665.4 if a selection is made, otherwise
;RMPRIN is PASSED BACK AS -1.
I $G(RMPRDFN)'>0 S:$G(DFN)>0 RMPRDFN=DFN D:$G(DFN)'>0 EN1^RMPRUTL2
I '$D(^RMPR(665.4,"AH",RMPRDFN)) W !!,$C(7),?5,"NO LETTERS FOR THIS PATIENT!" S RMPRIN=-1 Q
N RMPRBDT,DIC,RI,DR,RB,DA,RMPLET,DIQ,Y,RO
S (RMPRBDT,RI,RB,RO)=0,RMPRIN=-1,DIC=665.4,DR=".01;1;2;4;11",DIQ="RMPRLET"
W !!,"#",?5,"Patient",?28,"Type of letter",?45,"Employee"
W ?65,"Date of letter"
W !,RMPR("L")
F S RMPRBDT=$O(^RMPR(665.4,"AH",RMPRDFN,RMPRBDT)) Q:RMPRBDT="" D Q:RO=1
.;check for more than one letter per day
.S DA=0
.F S DA=$O(^RMPR(665.4,"AH",RMPRDFN,RMPRBDT,DA)) Q:'DA D Q:RO=1
..S RI=RI+1,RI(RI)=DA D EN^DIQ1 Q:'$D(RMPRLET)
..S RB=RB+1
..W !,RI
..W ?5,RMPRLET(665.4,DA,.01),?28,$G(RMPRLET(665.4,DA,1))
..W ?45,$E($G(RMPRLET(665.4,DA,4)),1,15)
..W ?65,$G(RMPRLET(665.4,DA,2))_$G(RMPRLET(665.4,DA,11))
..K RMPRLET
..I RB>4&(RMPRIN<1) D ASK Q:RMPRIN>0 S RB=0
G:$D(DTOUT)!($D(DUOUT)) EXIT
I RMPRIN'>0 S:'RI(RI) RI=RI-1 D ASK Q
G EXIT
Q
ASK ;get record
I RMPRBDT="",DA="" W !!,"End of Patient's Letter Listing."
W !!,"Enter '^' to stop or "
N DIR S DIR(0)="NO^1:"_RI_":0" D ^DIR
I ($D(DTOUT))!($D(DUOUT)) S RO=1 Q
I +Y>0 S RMPRIN=RI(Y),RO=1 Q
Q
EXIT ;common exit point
K DTOUT,DUOUT,RMPRBDT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRUTL2 1582 printed Apr 09, 2024@21:38:27 Page 2
RMPRUTL2 ;PHX/HPL-Patient Letter Date look-up in chronological order ;05/22/1995
+1 ;;3.0;PROSTHETICS;;Feb 09, 1996
EN1 ;entry point to ask patient
+1 IF '$DATA(RMPR)
DO DIV4^RMPRSIT
+2 DO GETPAT^RMPRUTIL
if '$DATA(RMPRDFN)
QUIT
EN ;entry point pass RMPRDFN
+1 ;return RMPRPRIN as ien of 665.4 if a selection is made, otherwise
+2 ;RMPRIN is PASSED BACK AS -1.
+3 IF $GET(RMPRDFN)'>0
if $GET(DFN)>0
SET RMPRDFN=DFN
if $GET(DFN)'>0
DO EN1^RMPRUTL2
+4 IF '$DATA(^RMPR(665.4,"AH",RMPRDFN))
WRITE !!,$CHAR(7),?5,"NO LETTERS FOR THIS PATIENT!"
SET RMPRIN=-1
QUIT
+5 NEW RMPRBDT,DIC,RI,DR,RB,DA,RMPLET,DIQ,Y,RO
+6 SET (RMPRBDT,RI,RB,RO)=0
SET RMPRIN=-1
SET DIC=665.4
SET DR=".01;1;2;4;11"
SET DIQ="RMPRLET"
+7 WRITE !!,"#",?5,"Patient",?28,"Type of letter",?45,"Employee"
+8 WRITE ?65,"Date of letter"
+9 WRITE !,RMPR("L")
+10 FOR
SET RMPRBDT=$ORDER(^RMPR(665.4,"AH",RMPRDFN,RMPRBDT))
if RMPRBDT=""
QUIT
Begin DoDot:1
+11 ;check for more than one letter per day
+12 SET DA=0
+13 FOR
SET DA=$ORDER(^RMPR(665.4,"AH",RMPRDFN,RMPRBDT,DA))
if 'DA
QUIT
Begin DoDot:2
+14 SET RI=RI+1
SET RI(RI)=DA
DO EN^DIQ1
if '$DATA(RMPRLET)
QUIT
+15 SET RB=RB+1
+16 WRITE !,RI
+17 WRITE ?5,RMPRLET(665.4,DA,.01),?28,$GET(RMPRLET(665.4,DA,1))
+18 WRITE ?45,$EXTRACT($GET(RMPRLET(665.4,DA,4)),1,15)
+19 WRITE ?65,$GET(RMPRLET(665.4,DA,2))_$GET(RMPRLET(665.4,DA,11))
+20 KILL RMPRLET
+21 IF RB>4&(RMPRIN<1)
DO ASK
if RMPRIN>0
QUIT
SET RB=0
End DoDot:2
if RO=1
QUIT
End DoDot:1
if RO=1
QUIT
+22 if $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXIT
+23 IF RMPRIN'>0
if 'RI(RI)
SET RI=RI-1
DO ASK
QUIT
+24 GOTO EXIT
+25 QUIT
ASK ;get record
+1 IF RMPRBDT=""
IF DA=""
WRITE !!,"End of Patient's Letter Listing."
+2 WRITE !!,"Enter '^' to stop or "
+3 NEW DIR
SET DIR(0)="NO^1:"_RI_":0"
DO ^DIR
+4 IF ($DATA(DTOUT))!($DATA(DUOUT))
SET RO=1
QUIT
+5 IF +Y>0
SET RMPRIN=RI(Y)
SET RO=1
QUIT
+6 QUIT
EXIT ;common exit point
+1 KILL DTOUT,DUOUT,RMPRBDT
+2 QUIT
