source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRUTL3.m@ 1765

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

initial load of FOIAVistA 6/30/08 version

File size: 1.4 KB
Line 
1RMPRUTL3 ;PHX/HPL-UTILITY FOR USE WITH PROS LETTERS ;8/29/1994
2 ;;3.0;PROSTHETICS;;Feb 09, 1996
3EN2(PATIENTD) ;;PRSNT BCKWRDS LIST FOR SELCT OF PROS LETTER
4 N X,Y,RMPRG
5 S RMPR9ZRO=0 K RMPRHPL
6 W @IOF W !!!," " K ^TMP($J,"RMPR","AA")
7 S RMPRBB=0,RMPRG=7 K DA
8 F S RMPRBB=RMPRBB+1,ENTRY=" ",RMPR9ZRO=$O(^TMP($J,"RMPR",RMPR9ZRO)) D
9 .Q:RMPR9ZRO'>0 R:$Y#RMPRG=0 !,"Press 'RETURN' to continue, or enter a number: ",ENTRY:60
10 .Q:$G(ENTRY)="^" W:$G(ENTRY)="" !!,"" K:$G(ENTRY)="" ENTRY G:$G(ENTRY)>0&($G(ENTRY)<RMPRBB+1) GOTENT D
11 ..S RMPRG=12
12 ..W !,RMPRBB S ^TMP($J,"RMPR","AA",RMPRBB)=^TMP($J,"RMPR",RMPR9ZRO) W ?4,$P(^DPT(PATIENTD,0),U,1)
13 ..Q:$G(RMPR9ZRO)'>0 W ?35,$P(^RMPR(665.2,$P(^RMPR(665.4,^TMP($J,"RMPR",RMPR9ZRO),0),U,2),0),U,1)
14 ..W ?60,$$FMTE^XLFDT($P(^RMPR(665.4,^TMP($J,"RMPR",RMPR9ZRO),0),U,3),"2P") ;_$P($G(^RMPR(665.4,^TMP($J,"RMPR",RMPR9ZRO),5)),U,1)
15 R !,"Select LETTER: ",ENTRY:DTIME I $G(ENTRY)'>0!($G(ENTRY)>RMPRBB) Q ""
16GOTENT S DA=^TMP($J,"RMPR","AA",ENTRY)
17 S RMPR9ZRO=DA
18 Q RMPR9ZRO
19GETPAT(DA) ;GET PATIENT
20 S DIC="^DPT(",DIC(0)="AEQM",DIC("A")="Select PATIENT: " D ^DIC S DA=+Y
21 Q DA
22BAC(PATIENTD) ;SET UP A TEMPORARY BACKWARD STRING IN THE LETTER FILE
23 N RMPRLP,RMPRIEN,RMPRNO
24 K ^TMP("RMPR",$J) Q:$G(PATIENTD)=""
25 S RMPRIEN=0,RMPRLP=0 F S RMPRLP=RMPRLP+1,RMPRNO=$P(^RMPR(665.4,0),U,3)+999 S RMPRIEN=$O(^RMPR(665.4,"B",PATIENTD,RMPRIEN)) Q:RMPRIEN'>0 S ^TMP($J,"RMPR",(RMPRNO-RMPRIEN))=RMPRIEN
26 Q
Note: See TracBrowser for help on using the repository browser.