87 lines
4.2 KiB
Mathematica
87 lines
4.2 KiB
Mathematica
RMPFPRE ;DDC/KAW-PRE-INIT FOR ROES V2.0 [ 06/16/95 3:06 PM ]
|
|
;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
|
|
W !!,"ROES Version 2.0 PRE-INIT"
|
|
S RMPFLG=$O(^DIC(9.4,"B","REMOTE ORDER/ENTRY SYSTEM",0)) G END:'RMPFLG
|
|
CH0 W !!,"Changing menu name 'RMPF O/E STATION' to 'RMPF O/E STATION ASPS'."
|
|
S DA=$O(^DIC(19,"B","RMPF O/E STATION",0)) G CH1:'DA
|
|
S X="RMPF O/E STATION ASPS",DIE="^DIC(19,",DR=".01////"_X D ^DIE
|
|
CH1 W !!,"Changing mail group name 'RMPF ROES UPDATES' to 'RMPF ROES UPDATES (ASPS)'."
|
|
S DA=$O(^XMB(3.8,"B","RMPF ROES UPDATES",0)) G CH6:'DA
|
|
S X="RMPF ROES UPDATES (ASPS)",DIE="^XMB(3.8,",DR=".01////"_X D ^DIE
|
|
CH6 W !!,"Changing bulletin name 'RMPFMESSAGE' to 'RMPFMESSAGE (ASPS)'."
|
|
S DA=$O(^XMB(3.6,"B","RMPFMESSAGE",0))
|
|
G CH2:'DA
|
|
S X="RMPFMESSAGE (ASPS)",DIE="^XMB(3.6,",DR=".01////"_X D ^DIE
|
|
CH2 W !!,"Changing order type name 'STOCK H.A. ORDER' to 'STOCK HEARING AID ORDER'"
|
|
S DA=$O(^RMPF(791810.1,"B","STOCK H.A. ORDER",0))
|
|
G CH21:'DA
|
|
S X="STOCK HEARING AID ORDER",DIE="^RMPF(791810.1,"
|
|
S DR=".01////"_X D ^DIE
|
|
CH21 W !!,"Changing order type name 'H.A. REGISTRATION' to 'HEARING AID REGISTRATION'."
|
|
S DA=$O(^RMPF(791810.1,"B","H.A. REGISTRATION",0))
|
|
G CH22:'DA
|
|
S X="HEARING AID REGISTRATION",DIE="^RMPF(791810.1,"
|
|
S DR=".01////"_X D ^DIE
|
|
CH22 W !!,"Changing order type name 'CUSTOM H.A. ORDER' to 'CUSTOM HEARING AID ORDER'."
|
|
S DA=$O(^RMPF(791810.1,"B","CUSTOM H.A. ORDER",0)) G CH23:'DA
|
|
S X="CUSTOM HEARING AID ORDER",DIE="^RMPF(791810.1,"
|
|
S DR=".01////"_X D ^DIE
|
|
CH23 W !!,"Changing order type name 'LOST AID REPORT' to 'LOST HEARING AID REPORT'."
|
|
S DA=$O(^RMPF(791810.1,"B","LOST AID REPORT",0)) G CH24:'DA
|
|
S X="LOST HEARING AID REPORT",DIE="^RMPF(791810.1,"
|
|
S DR=".01////"_X D ^DIE
|
|
CH24 W !!,"Changing order type name 'UNFILL AN ORDER' to 'CANCEL ORDER'."
|
|
S DA=$O(^RMPF(791810.1,"B","UNFILL AN ORDER",0)) G CH25:'DA
|
|
S X="CANCEL ORDER",DIE="^RMPF(791810.1,"
|
|
S DR=".01////"_X D ^DIE
|
|
CH25 W !!,"Changing order type name 'MISSING AID REPORT' to 'MISSING HEARING AID REPORT'."
|
|
S DA=$O(^RMPF(791810.1,"B","MISSING AID REPORT",0)) G CH3:'DA
|
|
S X="MISSING HEARING AID REPORT",DIE="^RMPF(791810.1,"
|
|
S DR=".01////"_X D ^DIE
|
|
CH3 W !!,"Changing order type name 'ISSUE DATE/ORDER COMPLETION' to",!," 'CUSTOM HEARING AID ISSUE'"
|
|
S DA=$O(^RMPF(791810.1,"B","ISSUE DATE/ORDER COMPLETION",0))
|
|
G CH4:'DA
|
|
S X="CUSTOM HEARING AID ISSUE",DIE="^RMPF(791810.1,"
|
|
S DR=".01////"_X D ^DIE
|
|
CH4 W !!,"Changing the order type name 'CANCEL PATIENT ORDER' to 'CANCEL CUSTOM HEARING AID ORDER'."
|
|
S DA=$O(^RMPF(791810.1,"B","CANCEL PATIENT ORDER",0))
|
|
G CH41:'DA
|
|
S X="CANCEL CUSTOM HEARING AID ORDER",DIE="^RMPF(791810.1,",DR=".01////"_X D ^DIE
|
|
CH41 S DA=$O(^RMPF(791810.1,"B","CANCEL CHA ORDER",0)) G CH61:'DA
|
|
S X="CANCEL CUSTOM HEARING AID ORDER",DIE="^RMPF(791810.1,",DR=".01////"_X D ^DIE
|
|
CH61 D ^RMPFPRE2
|
|
CH7 W !!,"Removing disability conditions '5163' and '6016'."
|
|
S DA=$O(^RMPF(791810.4,"B",5163,0)) G CH71:'DA
|
|
S DIK="^RMPF(791810.4," D ^DIK
|
|
CH71 S DA=$O(^RMPF(791810.4,"B",6016,0)) G EXIT:'DA
|
|
S DIK="^RMPF(791810.4," D ^DIK
|
|
EXIT F X=0:0 S X=$O(^DD(791810,.01,1,X)) Q:'X D
|
|
.K:$G(^DD(791810,.01,1,X,0))="791810^AD^MUMPS" ^DD(791810,.01,1,X)
|
|
K ^DD(791810,0,"IX","AD",791810,.01)
|
|
K ^RMPF(791810,"AD")
|
|
K ^DD(791810.0101,.02,12),^DD(791810.0101,.02,12.1)
|
|
W !!,"Deleting old order type edit fields."
|
|
S X=0 F S X=$O(^RMPF(791810.1,X)) Q:'X K ^RMPF(791810.1,X,100)
|
|
W !!,"Setting up ORDER DELAY REASONS."
|
|
G EXIT1:'$D(^RMPF(791810.6,0)) S DA=0
|
|
F DA=1:1:7 S K=$T(REASON+DA),X=$P(K,";;",2) S RMPF(X)=""
|
|
S X="" F DA=1:1:7 S X=$O(RMPF(X)) I X'="" S DIE="^RMPF(791810.6,",DR=".01////"_X D ^DIE
|
|
EXIT1 D ^RMPFPRE1
|
|
W !!!?10,"*** PRE-INIT COMPLETE ***"
|
|
END K DIC,DR,DA,X,Y,DIK,FX,D,D0,DI,DIE,DQ Q
|
|
READ K RMPFOUT,RMPFQUT
|
|
R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
|
|
I Y?1"^".E S (RMPFOUT,Y)="" Q
|
|
S:Y?1"?".E (RMPFQUT,Y)=""
|
|
Q
|
|
REASON ;;Reasons for delay in order
|
|
;;MODIFICATION OF CIRCUITRY REQUIRED
|
|
;;PATIENT FAILED TO REPORT FOR APPOINTMENT
|
|
;;OTHER
|
|
;;HEARING AID DEFECTIVE FROM MANUFACTURER
|
|
;;PATIENT REQUESTED DELAY OR RESCHEDULED ORIGINAL APPT
|
|
;;CLINIC RESCHEDULED ORIGINAL APPOINTMENT
|
|
;;HEARING AID NOT RECEIVED IN TIME FOR HAE
|
|
;;NO AVAILABLE APPOINTMENT W/I 40 WORKING DAYS
|
|
;;MEDICAL CLEARANCE REQUIRED
|