| 1 | RMPOLETA ;EDS/PAK - HOME OXYGEN LETTERS ;8/6/98 07:37
|
|---|
| 2 | ;;3.0;PROSTHETICS;**29**;Feb 09, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | SELECT ;
|
|---|
| 5 | N LSTN,CNT,ANS
|
|---|
| 6 | ;
|
|---|
| 7 | S ANS="Q"
|
|---|
| 8 | D PROMPT
|
|---|
| 9 | D:ANS'="Q" PRINT^RMPOLET1(ANS)
|
|---|
| 10 | D EXIT
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | PROMPT ;Prompt for letter list groups to print
|
|---|
| 14 | W @IOF,!?30,RMPO("NAME"),!?15,"HOME OXYGEN PATIENT LISTING FOR - "
|
|---|
| 15 | S CNT=0,Y=DT X ^DD("DD") W Y,!?35,"LETTERS",!!
|
|---|
| 16 | S LSTN=1,RMPOLCD=0
|
|---|
| 17 | F S RMPOLCD=$O(^TMP($J,"RMPOLST",RMPOLCD)) Q:RMPOLCD="" D S LSTN(LSTN)=RMPOLCD,LSTN=LSTN+1 W CNT," patients."
|
|---|
| 18 | . S CNT=0,RMPODFN=""
|
|---|
| 19 | . F S RMPODFN=$O(^TMP($J,"RMPOLST",RMPOLCD,RMPODFN)) Q:RMPODFN="" S CNT=CNT+1
|
|---|
| 20 | . I $E(RMPOLCD,1)="A" W !,?15,LSTN,".",?19,"Welcome to Home Oxygen Program Letter group of "
|
|---|
| 21 | . I $E(RMPOLCD,1)="B" W !,?15,LSTN,".",?19,"Prescription Cancellation Letter group of "
|
|---|
| 22 | . I $E(RMPOLCD,1)="C" W !,?15,LSTN,".",?19,$E(RMPOLCD,2,4)," day Rx expiration group of "
|
|---|
| 23 | I 'CNT W !!,"No patient letters to print today." H 5 Q
|
|---|
| 24 | ASK ;
|
|---|
| 25 | W !!,"The list above shows the letters that have been compiled."
|
|---|
| 26 | W !,"and how many patients will receive each letter."
|
|---|
| 27 | F D Q:ANS'=""
|
|---|
| 28 | .W !!,"Enter a number of a letter you wish to print or 'ALL': ALL // "
|
|---|
| 29 | .R ANS:DTIME S:ANS="" ANS="A" I '$T!("^"[ANS) S ANS="Q" Q
|
|---|
| 30 | .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'."
|
|---|
| 31 | S:ANS>0 ANS=LSTN(ANS) ; translate answer into letter code
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | EXIT D ^%ZISC
|
|---|
| 35 | K ^TMP($J),ANS,DIC,X1,X2,Y,ZTSAVE,POP,X,DFN,VADM,VAPA,%,ANSW,%ZIS
|
|---|
| 36 | K RMPODAYS,RMPO,RMPOLTR,RMPOLCD,RMPOEXP
|
|---|
| 37 | K RMPORXDT,RMPORX,BTYP,DIE,DR,RMPOITEM,VAL
|
|---|
| 38 | Q
|
|---|
