RMPOLETA ;EDS/PAK - HOME OXYGEN LETTERS ;8/6/98 07:37
;;3.0;PROSTHETICS;**29**;Feb 09, 1996
;
SELECT ;
N LSTN,CNT,ANS
;
S ANS="Q"
D PROMPT
D:ANS'="Q" PRINT^RMPOLET1(ANS)
D EXIT
Q
;
PROMPT ;Prompt for letter list groups to print
W @IOF,!?30,RMPO("NAME"),!?15,"HOME OXYGEN PATIENT LISTING FOR - "
S CNT=0,Y=DT X ^DD("DD") W Y,!?35,"LETTERS",!!
S LSTN=1,RMPOLCD=0
F S RMPOLCD=$O(^TMP($J,"RMPOLST",RMPOLCD)) Q:RMPOLCD="" D S LSTN(LSTN)=RMPOLCD,LSTN=LSTN+1 W CNT," patients."
. S CNT=0,RMPODFN=""
. F S RMPODFN=$O(^TMP($J,"RMPOLST",RMPOLCD,RMPODFN)) Q:RMPODFN="" S CNT=CNT+1
. I $E(RMPOLCD,1)="A" W !,?15,LSTN,".",?19,"Welcome to Home Oxygen Program Letter group of "
. I $E(RMPOLCD,1)="B" W !,?15,LSTN,".",?19,"Prescription Cancellation Letter group of "
. I $E(RMPOLCD,1)="C" W !,?15,LSTN,".",?19,$E(RMPOLCD,2,4)," day Rx expiration group of "
I 'CNT W !!,"No patient letters to print today." H 5 Q
ASK ;
W !!,"The list above shows the letters that have been compiled."
W !,"and how many patients will receive each letter."
F D Q:ANS'=""
.W !!,"Enter a number of a letter you wish to print or 'ALL': ALL // "
.R ANS:DTIME S:ANS="" ANS="A" I '$T!("^"[ANS) S ANS="Q" Q
.I $E("ALL",1,$L(ANS))'=$TR(ANS,"al","AL"),($S(ANS'?1.N:1,ANS>CNT:1,ANS<1:1,1:0)) S ANS="" W !!,"Please enter a number from 1 to "_CNT_" or 'ALL'."
S:ANS>0 ANS=LSTN(ANS) ; translate answer into letter code
Q
;
EXIT D ^%ZISC
K ^TMP($J),ANS,DIC,X1,X2,Y,ZTSAVE,POP,X,DFN,VADM,VAPA,%,ANSW,%ZIS
K RMPODAYS,RMPO,RMPOLTR,RMPOLCD,RMPOEXP
K RMPORXDT,RMPORX,BTYP,DIE,DR,RMPOITEM,VAL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPOLETA 1619 printed Apr 09, 2024@21:34:05 Page 2
RMPOLETA ;EDS/PAK - HOME OXYGEN LETTERS ;8/6/98 07:37
+1 ;;3.0;PROSTHETICS;**29**;Feb 09, 1996
+2 ;
SELECT ;
+1 NEW LSTN,CNT,ANS
+2 ;
+3 SET ANS="Q"
+4 DO PROMPT
+5 if ANS'="Q"
DO PRINT^RMPOLET1(ANS)
+6 DO EXIT
+7 QUIT
+8 ;
PROMPT ;Prompt for letter list groups to print
+1 WRITE @IOF,!?30,RMPO("NAME"),!?15,"HOME OXYGEN PATIENT LISTING FOR - "
+2 SET CNT=0
SET Y=DT
XECUTE ^DD("DD")
WRITE Y,!?35,"LETTERS",!!
+3 SET LSTN=1
SET RMPOLCD=0
+4 FOR
SET RMPOLCD=$ORDER(^TMP($JOB,"RMPOLST",RMPOLCD))
if RMPOLCD=""
QUIT
Begin DoDot:1
+5 SET CNT=0
SET RMPODFN=""
+6 FOR
SET RMPODFN=$ORDER(^TMP($JOB,"RMPOLST",RMPOLCD,RMPODFN))
if RMPODFN=""
QUIT
SET CNT=CNT+1
+7 IF $EXTRACT(RMPOLCD,1)="A"
WRITE !,?15,LSTN,".",?19,"Welcome to Home Oxygen Program Letter group of "
+8 IF $EXTRACT(RMPOLCD,1)="B"
WRITE !,?15,LSTN,".",?19,"Prescription Cancellation Letter group of "
+9 IF $EXTRACT(RMPOLCD,1)="C"
WRITE !,?15,LSTN,".",?19,$EXTRACT(RMPOLCD,2,4)," day Rx expiration group of "
End DoDot:1
SET LSTN(LSTN)=RMPOLCD
SET LSTN=LSTN+1
WRITE CNT," patients."
+10 IF 'CNT
WRITE !!,"No patient letters to print today."
HANG 5
QUIT
ASK ;
+1 WRITE !!,"The list above shows the letters that have been compiled."
+2 WRITE !,"and how many patients will receive each letter."
+3 FOR
Begin DoDot:1
+4 WRITE !!,"Enter a number of a letter you wish to print or 'ALL': ALL // "
+5 READ ANS:DTIME
if ANS=""
SET ANS="A"
IF '$TEST!("^"[ANS)
SET ANS="Q"
QUIT
+6 IF $EXTRACT("ALL",1,$LENGTH(ANS))'=$TRANSLATE(ANS,"al","AL")
IF ($SELECT(ANS'?1.N:1,ANS>CNT:1,ANS<1:1,1:0))
SET ANS=""
WRITE !!,"Please enter a number from 1 to "_CNT_" or 'ALL'."
End DoDot:1
if ANS'=""
QUIT
+7 ; translate answer into letter code
if ANS>0
SET ANS=LSTN(ANS)
+8 QUIT
+9 ;
EXIT DO ^%ZISC
+1 KILL ^TMP($JOB),ANS,DIC,X1,X2,Y,ZTSAVE,POP,X,DFN,VADM,VAPA,%,ANSW,%ZIS
+2 KILL RMPODAYS,RMPO,RMPOLTR,RMPOLCD,RMPOEXP
+3 KILL RMPORXDT,RMPORX,BTYP,DIE,DR,RMPOITEM,VAL
+4 QUIT
