source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPOLETA.m@ 1432

Last change on this file since 1432 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1RMPOLETA ;EDS/PAK - HOME OXYGEN LETTERS ;8/6/98 07:37
2 ;;3.0;PROSTHETICS;**29**;Feb 09, 1996
3 ;
4SELECT ;
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 ;
13PROMPT ;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
24ASK ;
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 ;
34EXIT 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
Note: See TracBrowser for help on using the repository browser.