source: WorldVistAEHR/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFPRE.m@ 1749

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

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1RMPFPRE ;DDC/KAW-PRE-INIT FOR ROES V2.0 [ 06/16/95 3:06 PM ]
2 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
3 W !!,"ROES Version 2.0 PRE-INIT"
4 S RMPFLG=$O(^DIC(9.4,"B","REMOTE ORDER/ENTRY SYSTEM",0)) G END:'RMPFLG
5CH0 W !!,"Changing menu name 'RMPF O/E STATION' to 'RMPF O/E STATION ASPS'."
6 S DA=$O(^DIC(19,"B","RMPF O/E STATION",0)) G CH1:'DA
7 S X="RMPF O/E STATION ASPS",DIE="^DIC(19,",DR=".01////"_X D ^DIE
8CH1 W !!,"Changing mail group name 'RMPF ROES UPDATES' to 'RMPF ROES UPDATES (ASPS)'."
9 S DA=$O(^XMB(3.8,"B","RMPF ROES UPDATES",0)) G CH6:'DA
10 S X="RMPF ROES UPDATES (ASPS)",DIE="^XMB(3.8,",DR=".01////"_X D ^DIE
11CH6 W !!,"Changing bulletin name 'RMPFMESSAGE' to 'RMPFMESSAGE (ASPS)'."
12 S DA=$O(^XMB(3.6,"B","RMPFMESSAGE",0))
13 G CH2:'DA
14 S X="RMPFMESSAGE (ASPS)",DIE="^XMB(3.6,",DR=".01////"_X D ^DIE
15CH2 W !!,"Changing order type name 'STOCK H.A. ORDER' to 'STOCK HEARING AID ORDER'"
16 S DA=$O(^RMPF(791810.1,"B","STOCK H.A. ORDER",0))
17 G CH21:'DA
18 S X="STOCK HEARING AID ORDER",DIE="^RMPF(791810.1,"
19 S DR=".01////"_X D ^DIE
20CH21 W !!,"Changing order type name 'H.A. REGISTRATION' to 'HEARING AID REGISTRATION'."
21 S DA=$O(^RMPF(791810.1,"B","H.A. REGISTRATION",0))
22 G CH22:'DA
23 S X="HEARING AID REGISTRATION",DIE="^RMPF(791810.1,"
24 S DR=".01////"_X D ^DIE
25CH22 W !!,"Changing order type name 'CUSTOM H.A. ORDER' to 'CUSTOM HEARING AID ORDER'."
26 S DA=$O(^RMPF(791810.1,"B","CUSTOM H.A. ORDER",0)) G CH23:'DA
27 S X="CUSTOM HEARING AID ORDER",DIE="^RMPF(791810.1,"
28 S DR=".01////"_X D ^DIE
29CH23 W !!,"Changing order type name 'LOST AID REPORT' to 'LOST HEARING AID REPORT'."
30 S DA=$O(^RMPF(791810.1,"B","LOST AID REPORT",0)) G CH24:'DA
31 S X="LOST HEARING AID REPORT",DIE="^RMPF(791810.1,"
32 S DR=".01////"_X D ^DIE
33CH24 W !!,"Changing order type name 'UNFILL AN ORDER' to 'CANCEL ORDER'."
34 S DA=$O(^RMPF(791810.1,"B","UNFILL AN ORDER",0)) G CH25:'DA
35 S X="CANCEL ORDER",DIE="^RMPF(791810.1,"
36 S DR=".01////"_X D ^DIE
37CH25 W !!,"Changing order type name 'MISSING AID REPORT' to 'MISSING HEARING AID REPORT'."
38 S DA=$O(^RMPF(791810.1,"B","MISSING AID REPORT",0)) G CH3:'DA
39 S X="MISSING HEARING AID REPORT",DIE="^RMPF(791810.1,"
40 S DR=".01////"_X D ^DIE
41CH3 W !!,"Changing order type name 'ISSUE DATE/ORDER COMPLETION' to",!," 'CUSTOM HEARING AID ISSUE'"
42 S DA=$O(^RMPF(791810.1,"B","ISSUE DATE/ORDER COMPLETION",0))
43 G CH4:'DA
44 S X="CUSTOM HEARING AID ISSUE",DIE="^RMPF(791810.1,"
45 S DR=".01////"_X D ^DIE
46CH4 W !!,"Changing the order type name 'CANCEL PATIENT ORDER' to 'CANCEL CUSTOM HEARING AID ORDER'."
47 S DA=$O(^RMPF(791810.1,"B","CANCEL PATIENT ORDER",0))
48 G CH41:'DA
49 S X="CANCEL CUSTOM HEARING AID ORDER",DIE="^RMPF(791810.1,",DR=".01////"_X D ^DIE
50CH41 S DA=$O(^RMPF(791810.1,"B","CANCEL CHA ORDER",0)) G CH61:'DA
51 S X="CANCEL CUSTOM HEARING AID ORDER",DIE="^RMPF(791810.1,",DR=".01////"_X D ^DIE
52CH61 D ^RMPFPRE2
53CH7 W !!,"Removing disability conditions '5163' and '6016'."
54 S DA=$O(^RMPF(791810.4,"B",5163,0)) G CH71:'DA
55 S DIK="^RMPF(791810.4," D ^DIK
56CH71 S DA=$O(^RMPF(791810.4,"B",6016,0)) G EXIT:'DA
57 S DIK="^RMPF(791810.4," D ^DIK
58EXIT F X=0:0 S X=$O(^DD(791810,.01,1,X)) Q:'X D
59 .K:$G(^DD(791810,.01,1,X,0))="791810^AD^MUMPS" ^DD(791810,.01,1,X)
60 K ^DD(791810,0,"IX","AD",791810,.01)
61 K ^RMPF(791810,"AD")
62 K ^DD(791810.0101,.02,12),^DD(791810.0101,.02,12.1)
63 W !!,"Deleting old order type edit fields."
64 S X=0 F S X=$O(^RMPF(791810.1,X)) Q:'X K ^RMPF(791810.1,X,100)
65 W !!,"Setting up ORDER DELAY REASONS."
66 G EXIT1:'$D(^RMPF(791810.6,0)) S DA=0
67 F DA=1:1:7 S K=$T(REASON+DA),X=$P(K,";;",2) S RMPF(X)=""
68 S X="" F DA=1:1:7 S X=$O(RMPF(X)) I X'="" S DIE="^RMPF(791810.6,",DR=".01////"_X D ^DIE
69EXIT1 D ^RMPFPRE1
70 W !!!?10,"*** PRE-INIT COMPLETE ***"
71END K DIC,DR,DA,X,Y,DIK,FX,D,D0,DI,DIE,DQ Q
72READ K RMPFOUT,RMPFQUT
73 R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
74 I Y?1"^".E S (RMPFOUT,Y)="" Q
75 S:Y?1"?".E (RMPFQUT,Y)=""
76 Q
77REASON ;;Reasons for delay in order
78 ;;MODIFICATION OF CIRCUITRY REQUIRED
79 ;;PATIENT FAILED TO REPORT FOR APPOINTMENT
80 ;;OTHER
81 ;;HEARING AID DEFECTIVE FROM MANUFACTURER
82 ;;PATIENT REQUESTED DELAY OR RESCHEDULED ORIGINAL APPT
83 ;;CLINIC RESCHEDULED ORIGINAL APPOINTMENT
84 ;;HEARING AID NOT RECEIVED IN TIME FOR HAE
85 ;;NO AVAILABLE APPOINTMENT W/I 40 WORKING DAYS
86 ;;MEDICAL CLEARANCE REQUIRED
Note: See TracBrowser for help on using the repository browser.