source: FOIAVistA/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFET1.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1RMPFET1 ;DDC/KAW-ENTER/EDIT PATIENT ORDER [ 05/24/99 9:24 AM ]
2 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**15,17**;06/06/01
3 I $D(RMPFX) D EXIST G ORDER
4 E D ADD
5ORDER I $D(RMPFX),'$D(RMPFOUT) D END1,^RMPFET5
6END K RMPFHAT,RMPFST,RMPFTYP,RMPFTE
7END1 K %,%DT,%Y,D,D0,DA,DI,DIC,DIE,DQ,DR,X,DISYS,S0,S2 Q
8ADD ;;Add a new order
9 ;;input: RMPFTP,RMPFTE,DFN(opt.)
10 ;;output: RMPFTYP,RMPFHAT,RMPFST,RMPFX
11 W !!,"Do you wish to add an order? NO// " D READ
12 G ADDE:$D(RMPFOUT)
13ADD1 I $D(RMPFQUT) W !!,"Enter a <Y> to add an order, <N> or <RETURN> to exit." G ADD
14 S:Y="" Y="N" S Y=$E(Y,1) I "YyNn"'[Y S RMPFQUT="" G ADD1
15 I "Nn"[Y K RMPFX G ADDE
16ADD2 S RMPFST=1 I RMPFTP="P"
17TYP S DIC=791810.1,DIC(0)="AEQM",DIC("A")="Select Type of Order: "
18 S DIC("S")="I $P(^(0),U,3)=RMPFTP,'$P(^(0),U,7),$D(^RMPF(791810.1,Y,102,""B"",RMPFMENU))"
19 W ! D ^DIC K DIC G ADDE:Y=-1 S RMPFTYP=+Y
20AUTO S RMPFHAT=$P(^RMPF(791810.1,RMPFTYP,0),U,2)
21 I $P($G(^RMPF(791810.1,RMPFTYP,0)),U,2)="X" D
22 .W @IOF,!!,"EXTRA COMPONENT ORDERS"
23 .W !!?32,"*** REMINDER ***"
24 .W !!,"This module is used to place extra component orders for hearing aids orginally"
25 .W !!,"ordered through the DDC. The purchase order number for the orginal hearing aid"
26 .W !!,"order is required to place an extra component order. If the hearing aid order"
27 .W !!,"was placed after 07/01/01 the extra component order will only be accepted after"
28 .W !!,"the trial period, which is 180 days from the date of shipment."
29 .D CONT^RMPFET G END:$D(RMPFOUT)
30 E D
31 .S X=$P(^RMPF(791810.1,RMPFTYP,0),U,5)
32 .I $L(X) S X="*** "_X_" ***" W $C(7),!!,?80-$L(X)\2,X
33 S X="NOW",%DT="T" D ^%DT S X=Y
34 F J=1:1 Q:'$D(^RMPF(791810,"B",X)) S X=X+.00001
35 S DIC="^RMPF(791810,",DIC(0)="L",DIC("DR")=".15///"_RMPFMENU
36 S DLAYGO=791810 K DD,DO D FILE^DICN K DIC G ADDE:Y=-1 S RMPFX=+Y
37 I RMPFTP="P" D ADD^RMPFETL I $D(RMPFOUT)!(RMPFTE=""&('$P($G(^RMPF(791810,RMPFX,2)),U,6))) D KILL G ADDE
38 I RMPFTP="P" S XX=$P(RMPFTE,U,1) I XX'="" S XX=$O(^RMPF(791810.4,"B",XX,0))
39 S DIE="^RMPF(791810,",DA=RMPFX,X="NOW",%DT="T" D ^%DT
40 S DR=".02////"_RMPFTYP_";.03////"_RMPFST_";.05////"_DUZ_";.06////"_Y_";901////"_RMPFSTAP_";10.05////R"
41 I RMPFTP="P" S DR=DR_";.04////"_DFN I RMPFTE'="" S DR=DR_";2.02///"_$P(RMPFTE,U,1)_";2.03////"_DUZ_";2.04////"_$P(RMPFTE,U,2)_";2.05////"_DT
42 D ^DIE
43 I RMPFTP="P" S RMSEN=$O(^DGSL(38.1,"B",DFN,0)) I RMSEN,$P($G(^DGSL(38.1,RMSEN,0)),U,2) S $P(^RMPF(791810,RMPFX,2),U,13)=1
44ADDE K %,%DT,%Y,D,D0,DA,DI,DIC,DIE,DISYS,DQ,DR,J,X,XX,RMSEN Q
45EXIST ;;Access and existing order
46 ;; input: RMPFX,RMPFST,RMPFTYP,RMPFTP,RMPFHAT
47 ;;(RMPFNAM,RMPFDOB,RMPFSSN,RMPFDOD) (if patient order)
48 ;;output: None
49 I '$D(^RMPF(791810,RMPFX,0)) W $C(7),!!,"THIS ORDER DOES NOT EXIST - FILE ERROR" G EXISTE
50 S S2=$G(^RMPF(791810,RMPFX,2)) G EDIT:RMPFTP="S" S X=$P(S2,U,2)
51 I X,$D(^RMPF(791810.4,X,0)) G EDIT
52 D ADD^RMPFETL G EXISTE:$D(RMPFOUT)
53 I RMPFTE=""&('$P($G(^RMPF(791810,RMPFX,2)),U,6)) W !!,"*** MUST ENTER AN ELIGIBILITY ***" G EXIST
54 G EXISTE
55EDIT I RMPFTP="P" S RMPFTE=$P(^RMPF(791810.4,$P(S2,U,2),0),U,1)_U_$P(S2,U,4) D EDIT^RMPFETL
56EXISTE K S0,S1,S2,I,X Q
57DELETE W !!,"Are you sure you want to delete this order? NO// " D READ
58 G DELETEE:$D(RMPFOUT)
59DEL1 I $D(RMPFQUT) W !!,"If you enter a <Y> the order will be permanently deleted from this order.",!,"If you enter a <N> or <RETURN> the order will be retained on the order." G DELETE
60 S:Y="" Y="N" S Y=$E(Y,1) I "YyNn"'[Y S RMPFQUT="" G DEL1
61 G DELETEE:"Nn"[Y
62KILL S DA=RMPFX,DIK="^RMPF(791810," D ^DIK,REMOV^RMPFET10 S RMPFTE=""
63 W !!,"*** ORDER DELETED ***" H 2
64DELETEE K Y,DA,DIK,RMPFX,RMPFSEL Q
65READ K RMPFOUT,RMPFQUT
66 R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
67 I Y?1"^".E S (RMPFOUT,Y)="" Q
68 S:Y?1"?".E (RMPFQUT,Y)=""
69 Q
Note: See TracBrowser for help on using the repository browser.