source: WorldVistAEHR/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFET0.m@ 701

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1RMPFET0 ;DDC/KAW-SELECTION ORDER ACTIONS [ 11/06/97 4:53 PM ]
2 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**20**;MAY 30, 1995
3SELOPT ;; input: RMPFX,RMPFST,RMPFHAT,RMPFTYP
4 ;;output: RMPFSEL
5 F I=1:1 Q:$Y>20 W !
6SELEN W !,"Enter" S FX="" K RMPFSEL Q:'RMPFST
7 S SU=$P(^RMPF(791810.2,RMPFST,0),U,2)
8 F I="I","P","E","F","D" I SU=I,RMPFTYP'=5 W " Number, <E>dit, <D>elete" S FX=FX_"EeDd" Q
9SELOPT0 I RMPFTYP=5!(RMPFTYP=8) D ARRAY^RMPFDT2 D K RMPFO
10 .F I="I","P","E","F","D","S","B" I SU=I D
11 ..I $P(^RMPF(791810,RMPFX,0),"^",9)>3010630 D
12 ...W:FX'="" "," W " <A>djust" S FX=FX_"Aa"
13 ..S (X,FL)=0
14 ..F S X=$O(RMPFO(X)) Q:'X I $D(^RMPF(791810,RMPFX,101,X,90)),$P(^(90),U,9) S FL=1 Q
15 ..I FL,RMPFTYP'=8 W:FX'="" "," W " <I>ssue" S FX=FX_"Ii"
16 .S X=0
17 .F S X=$O(RMPFO(X)) Q:'X S S0=^RMPF(791810,RMPFX,101,X,0),Y=$P(S0,U,18) I Y,$D(^RMPF(791810.2,Y,0)) S Y=$P(^(0),U,2) I "SEDF"[Y D CERT Q:FX["Rr"
18 .I SU="C",FX'["A" S X=DT,Z=60 D PASTWKDY D
19 ..S X=0
20 ..F S X=$O(RMPFO(X)) Q:'X I $P(^(0),U,19)'="C" W:FX'="" "," W " <A>djust" S FX=FX_"Aa" Q
21 I $O(^RMPF(791810,RMPFX,201,0)) W:FX'="" "," W " <M>essages" S FX=FX_"Mm"
22 I $O(^RMPF(791810,RMPFX,301,0)) W:FX'="" "," W " A<U>thorized Aids" S FX=FX_"Uu"
23 D CAN I CN W:FX'="" "," W " <C>ancel" S FX=FX_"Cc"
24 I "CIX"[RMPFHAT W:FX'="" "," W:$X>69 ! W " <H>istory" S FX=FX_"Hh"
25 I RMPFTP="P" W:FX'="" "," W:$X>69 ! W " E<X>tended" S FX=FX_"Xx"
26 W:$X>69 ! W:FX'="" " or" W:$X>69 ! W " <RETURN>: "
27 D READ G SELOPTE:$D(RMPFOUT) K RMPFF,CN
28SELOPT1 I $D(RMPFQUT) D MSG K RMPFSEL G SELOPTE
29 I Y="" D ^RMPFEA2:'$D(RMPFERR) G SELOPTE:$D(RMPFOUT) K RMPFX G SELOPTE
30 I Y?1N.E,FX["Ee" S RMPFSEL=Y G NUM
31 S RMPFSEL=$E(Y,1)
32 I FX'[RMPFSEL S RMPFQUT="" G SELOPT1
33 I "Ee"[RMPFSEL S RMPFSEL="E" G SELOPTE
34 I "Hh"[RMPFSEL D ^RMPFDT7 G SELOPTE
35 I "Mm"[RMPFSEL D ^RMPFDT4 G SELOPTE
36 I "Dd"[RMPFSEL D DELETE^RMPFET1 G SELOPTE
37 I "Ii"[RMPFSEL D ^RMPFET7 G SELOPTE:$D(RMPFOUT) D ^RMPFET2 G SELOPTE
38 I "Rr"[RMPFSEL N RMPFSEL D DISP^RMPFET84 G SELOPTE
39 I "Aa"[RMPFSEL D ^RMPFET8 G SELOPTE:$D(RMPFOUT) D ^RMPFET2 G SELOPTE
40 I "Uu"[RMPFSEL D ^RMPFDT8 G SELOPTE
41 I "Cc"[RMPFSEL D ^RMPFET82 G SELOPTE
42 I "Xx"[RMPFSEL D ^RMPFDT9 G SELOPTE
43NUM K RMPFQUT
44 F I=1:1 S Z=$P(Y,",",I) Q:Z="" D G SELOPT1:$D(RMPFQUT)
45 .I Z?1N.N,Z>0,Z<11 S RMPFSL(Z)="" Q
46 .S RMPFQUT="" Q
47 I $D(RMPFSL) D SUB^RMPFET5
48SELOPTE K I,FX,Y,X,Z,SU,X1,X2,%Y,S0,A,FL
49END K ID Q
50CERT S A=$G(^RMPF(791810,RMPFX,101,X,90))
51 I '$P(A,U,11),$P(S0,U,20) Q
52 I '$P(A,U,9),"EDSF"[Y G CERT1
53 I $P(A,U,9),"EDF"[Y G CERT1
54 I $P(A,U,9),$P(S0,U,19)["R",$P(S0,U,20) G CERT1
55 E Q
56CERT1 W:FX'="" "," W:$P(A,U,9) " Re-" W:'$P(A,U,9) " " W "Ce<R>tify" S FX=FX_"Rr" Q
57CAN ;;Calculate if CANCEL ALLOWED
58 ;; input: RMPFHAT,RMPFX
59 ;;output: CN
60 D ARRAY^RMPFDT2
61 S CN=0 G CANE:"ICXZBDJQW"'[RMPFHAT
62 I "ZBDJQW"[RMPFHAT D G CANE
63 .S X=0 F S X=$O(RMPFO(X)) Q:'X I RMPFO(X)=18!($P(^RMPF(791810,RMPFX,101,X,0),U,15)="C") S CN=1 Q
64 S XX=0 F S XX=$O(RMPFO(XX)) Q:'XX D Q:CN
65 .I RMPFO(XX)=5!(RMPFO(XX)=17) S CN=1 Q
66 .I RMPFHAT="I",RMPFO(XX)=8 S X=DT,Z=60 D PASTWKDY S ID=$P(^RMPF(791810,RMPFX,101,XX,0),U,8) I ID>Y S CN=1
67CANE K X,XX,RMPFO Q
68READ K RMPFOUT,RMPFQUT
69 R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
70 I Y?1"^".E S (RMPFOUT,Y)="" Q
71 S:Y?1"?".E (RMPFQUT,Y)=""
72 Q
73PASTWKDY Q:X'?7N
74 ;returns a date Z workdays into the past
75 N BD,DW,WK,%H S WK=0 S:'$G(Z) Z=5
76W1 S X1=X,X2=-1 D C^%DTC,H^%DTC
77 I %Y,%Y<6,'$D(^HOLIDAY(X)) S WK=WK+1
78 I WK>Z S Y=X Q
79 G W1
80MSG W !!,"Enter " S CT=0
81 F I=1:2 S X=$E(FX,I) Q:X="" W:CT ! W ?6,$P($T(@X),";;",2) S CT=CT+1
82 F I="I","P","E","D" I SU=I W !?6,"field numbers separated by commas to edit only those fields" Q
83 W:FX'="" ! W ?6,"<RETURN> to continue.",!
84 W !!!,"Type <RETURN> to continue: " D READ I '$D(RMPFOUT) S RMPFQUT=""
85 K CT Q
86E ;;<E> to edit all fields of the order
87D ;;<D> to delete the entire order
88M ;;<M> to view all messages for the order
89H ;;<H> to view the order history
90I ;;<I> to enter the issue date
91A ;;<A> to make an adjustment
92C ;;<C> to cancel the order
93R ;;<R> to certify that the order was received
94U ;;<U> to view a list of authorized hearing aids
95X ;;<X> to view the extended information for this order
Note: See TracBrowser for help on using the repository browser.