source: WorldVistAEHR/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFDT8.m@ 1006

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

initial load of WorldVistAEHR

File size: 1.9 KB
RevLine 
[613]1RMPFDT8 ;DDC/KAW-DISPLAY AUTHORIZED AIDS [ 03/12/98 7:46 AM ]
2 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**10**;;JUN 16, 1995
3 ;; input: RMPFX,DFN
4 ;;output: None
5 Q:'$D(^RMPF(791810,RMPFX,301,1,0)) S Y=$P(^(0),U,8) D DD^%DT S DV=Y
6 D PAT^RMPFUTL,HEAD S (RX,CT)=0
7A1 S RX=$O(^RMPF(791810,RMPFX,301,RX)) G TOT:'RX
8 G A1:'$D(^RMPF(791810,RMPFX,301,RX,0)) S S0=^(0),CT=CT+1
9 S ID=$P(S0,U,3) S:ID?7N ID=$E(ID,4,5)_"-"_$E(ID,6,7)_"-"_($E(ID,1,3)+1700)
10 S MK=$E($P(S0,U,2),1,12),MD=$E($P(S0,U,1),1,12),SN=$E($P(S0,U,4),1,10)
11 S ST=$E($P(S0,U,5),1,4),BT=$E($P(S0,U,6),1,7),ER=$P(S0,U,7)
12 W !,$J(CT,2),?5,ID,?17,MK,?32,MD,?49,SN,?61,ST,?67,BT,?77,ER
13 G A1
14TOT W !!,"Total Number of Authorized Hearing Aids: ",CT
15 I IOST?1"P-".E W @IOF
16 D:$D(IO("S")) ^%ZISC
17 I IOST?1"C-".E D CONT,QUE:"Pp"[Y&(Y'="") I $D(RMION) K RMION G RMPFDT8
18END K Y,DV,RX,CT,S0,ID,MK,MD,SN,ST,BT,ER,ZTSK,RMPFOUT,RMPFQUT,I,POP
19 K RMPFDOB,RMPFDOD,RMPFNAM,RMPFSSN,%XX,%YY,X Q
20HEAD I IOST'?1"P-".E W @IOF
21 W !?28,"AUTHORIZED HEARING AIDS",!
22 W !?2,"Patient Name: ",RMPFNAM,?63,"SSN: ",RMPFSSN
23 W !,"Aids Validated: ",DV
24 W !?51,"Serial"
25 W !," #",?5,"Issue Date",?21,"Make",?37,"Model",?51,"Number",?61,"Sta.",?67,"Battery",?76,"Ear"
26 W !,"---",?5,"----------",?17,"-------------",?32,"---------------",?49,"----------",?61,"----",?67,"-------",?76,"---"
27 Q
28CONT F I=1:1 Q:$Y>21 W !
29 W !,"Enter <RETURN> to continue or <P>rint: " D READ
30 I $D(RMPFQUT) D MSG^RMPFDD G CONT
31 Q:Y="" S Y=$E(Y,1) I "Pp"'[Y G CONT
32 Q
33QUE W ! S %ZIS="NPQ" D ^%ZIS G END:POP K RMION
34 I IO=IO(0),'$D(IO("S")) K ZTSK S RMION=IO Q
35 I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS G ^RMPFDT8
36 S ZTRTN="^RMPFDT8",ZTDESC="AUTH AIDS",ZTIO=ION
37 S ZTSAVE("RMPFX")="",ZTSAVE("DFN")="" D ^%ZTLOAD
38 D HOME^%ZIS W:$D(ZTSK) !!,"*** Request Queued ***" H 2
39 K %T,POP Q
40READ K RMPFOUT,RMPFQUT
41 R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
42 I Y?1"^".E S (RMPFOUT,Y)="" Q
43 S:Y?1"?".E (RMPFQUT,Y)=""
44 Q
Note: See TracBrowser for help on using the repository browser.