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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFPRE 4340 printed Dec 13, 2024@02:36:40 Page 2
RMPFPRE ;DDC/KAW-PRE-INIT FOR ROES V2.0 [ 06/16/95 3:06 PM ]
+1 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
+2 WRITE !!,"ROES Version 2.0 PRE-INIT"
+3 SET RMPFLG=$ORDER(^DIC(9.4,"B","REMOTE ORDER/ENTRY SYSTEM",0))
if 'RMPFLG
GOTO END
CH0 WRITE !!,"Changing menu name 'RMPF O/E STATION' to 'RMPF O/E STATION ASPS'."
+1 SET DA=$ORDER(^DIC(19,"B","RMPF O/E STATION",0))
if 'DA
GOTO CH1
+2 SET X="RMPF O/E STATION ASPS"
SET DIE="^DIC(19,"
SET DR=".01////"_X
DO ^DIE
CH1 WRITE !!,"Changing mail group name 'RMPF ROES UPDATES' to 'RMPF ROES UPDATES (ASPS)'."
+1 SET DA=$ORDER(^XMB(3.8,"B","RMPF ROES UPDATES",0))
if 'DA
GOTO CH6
+2 SET X="RMPF ROES UPDATES (ASPS)"
SET DIE="^XMB(3.8,"
SET DR=".01////"_X
DO ^DIE
CH6 WRITE !!,"Changing bulletin name 'RMPFMESSAGE' to 'RMPFMESSAGE (ASPS)'."
+1 SET DA=$ORDER(^XMB(3.6,"B","RMPFMESSAGE",0))
+2 if 'DA
GOTO CH2
+3 SET X="RMPFMESSAGE (ASPS)"
SET DIE="^XMB(3.6,"
SET DR=".01////"_X
DO ^DIE
CH2 WRITE !!,"Changing order type name 'STOCK H.A. ORDER' to 'STOCK HEARING AID ORDER'"
+1 SET DA=$ORDER(^RMPF(791810.1,"B","STOCK H.A. ORDER",0))
+2 if 'DA
GOTO CH21
+3 SET X="STOCK HEARING AID ORDER"
SET DIE="^RMPF(791810.1,"
+4 SET DR=".01////"_X
DO ^DIE
CH21 WRITE !!,"Changing order type name 'H.A. REGISTRATION' to 'HEARING AID REGISTRATION'."
+1 SET DA=$ORDER(^RMPF(791810.1,"B","H.A. REGISTRATION",0))
+2 if 'DA
GOTO CH22
+3 SET X="HEARING AID REGISTRATION"
SET DIE="^RMPF(791810.1,"
+4 SET DR=".01////"_X
DO ^DIE
CH22 WRITE !!,"Changing order type name 'CUSTOM H.A. ORDER' to 'CUSTOM HEARING AID ORDER'."
+1 SET DA=$ORDER(^RMPF(791810.1,"B","CUSTOM H.A. ORDER",0))
if 'DA
GOTO CH23
+2 SET X="CUSTOM HEARING AID ORDER"
SET DIE="^RMPF(791810.1,"
+3 SET DR=".01////"_X
DO ^DIE
CH23 WRITE !!,"Changing order type name 'LOST AID REPORT' to 'LOST HEARING AID REPORT'."
+1 SET DA=$ORDER(^RMPF(791810.1,"B","LOST AID REPORT",0))
if 'DA
GOTO CH24
+2 SET X="LOST HEARING AID REPORT"
SET DIE="^RMPF(791810.1,"
+3 SET DR=".01////"_X
DO ^DIE
CH24 WRITE !!,"Changing order type name 'UNFILL AN ORDER' to 'CANCEL ORDER'."
+1 SET DA=$ORDER(^RMPF(791810.1,"B","UNFILL AN ORDER",0))
if 'DA
GOTO CH25
+2 SET X="CANCEL ORDER"
SET DIE="^RMPF(791810.1,"
+3 SET DR=".01////"_X
DO ^DIE
CH25 WRITE !!,"Changing order type name 'MISSING AID REPORT' to 'MISSING HEARING AID REPORT'."
+1 SET DA=$ORDER(^RMPF(791810.1,"B","MISSING AID REPORT",0))
if 'DA
GOTO CH3
+2 SET X="MISSING HEARING AID REPORT"
SET DIE="^RMPF(791810.1,"
+3 SET DR=".01////"_X
DO ^DIE
CH3 WRITE !!,"Changing order type name 'ISSUE DATE/ORDER COMPLETION' to",!," 'CUSTOM HEARING AID ISSUE'"
+1 SET DA=$ORDER(^RMPF(791810.1,"B","ISSUE DATE/ORDER COMPLETION",0))
+2 if 'DA
GOTO CH4
+3 SET X="CUSTOM HEARING AID ISSUE"
SET DIE="^RMPF(791810.1,"
+4 SET DR=".01////"_X
DO ^DIE
CH4 WRITE !!,"Changing the order type name 'CANCEL PATIENT ORDER' to 'CANCEL CUSTOM HEARING AID ORDER'."
+1 SET DA=$ORDER(^RMPF(791810.1,"B","CANCEL PATIENT ORDER",0))
+2 if 'DA
GOTO CH41
+3 SET X="CANCEL CUSTOM HEARING AID ORDER"
SET DIE="^RMPF(791810.1,"
SET DR=".01////"_X
DO ^DIE
CH41 SET DA=$ORDER(^RMPF(791810.1,"B","CANCEL CHA ORDER",0))
if 'DA
GOTO CH61
+1 SET X="CANCEL CUSTOM HEARING AID ORDER"
SET DIE="^RMPF(791810.1,"
SET DR=".01////"_X
DO ^DIE
CH61 DO ^RMPFPRE2
CH7 WRITE !!,"Removing disability conditions '5163' and '6016'."
+1 SET DA=$ORDER(^RMPF(791810.4,"B",5163,0))
if 'DA
GOTO CH71
+2 SET DIK="^RMPF(791810.4,"
DO ^DIK
CH71 SET DA=$ORDER(^RMPF(791810.4,"B",6016,0))
if 'DA
GOTO EXIT
+1 SET DIK="^RMPF(791810.4,"
DO ^DIK
EXIT FOR X=0:0
SET X=$ORDER(^DD(791810,.01,1,X))
if 'X
QUIT
Begin DoDot:1
+1 if $GET(^DD(791810,.01,1,X,0))="791810^AD^MUMPS"
KILL ^DD(791810,.01,1,X)
End DoDot:1
+2 KILL ^DD(791810,0,"IX","AD",791810,.01)
+3 KILL ^RMPF(791810,"AD")
+4 KILL ^DD(791810.0101,.02,12),^DD(791810.0101,.02,12.1)
+5 WRITE !!,"Deleting old order type edit fields."
+6 SET X=0
FOR
SET X=$ORDER(^RMPF(791810.1,X))
if 'X
QUIT
KILL ^RMPF(791810.1,X,100)
+7 WRITE !!,"Setting up ORDER DELAY REASONS."
+8 if '$DATA(^RMPF(791810.6,0))
GOTO EXIT1
SET DA=0
+9 FOR DA=1:1:7
SET K=$TEXT(REASON+DA)
SET X=$PIECE(K,";;",2)
SET RMPF(X)=""
+10 SET X=""
FOR DA=1:1:7
SET X=$ORDER(RMPF(X))
IF X'=""
SET DIE="^RMPF(791810.6,"
SET DR=".01////"_X
DO ^DIE
EXIT1 DO ^RMPFPRE1
+1 WRITE !!!?10,"*** PRE-INIT COMPLETE ***"
END KILL DIC,DR,DA,X,Y,DIK,FX,D,D0,DI,DIE,DQ
QUIT
READ KILL RMPFOUT,RMPFQUT
+1 READ Y:DTIME
IF '$TEST
WRITE $CHAR(7)
READ Y:5
if Y="."
GOTO READ
if '$TEST
SET Y=U
+2 IF Y?1"^".E
SET (RMPFOUT,Y)=""
QUIT
+3 if Y?1"?".E
SET (RMPFQUT,Y)=""
+4 QUIT
REASON ;;Reasons for delay in order
+1 ;;MODIFICATION OF CIRCUITRY REQUIRED
+2 ;;PATIENT FAILED TO REPORT FOR APPOINTMENT
+3 ;;OTHER
+4 ;;HEARING AID DEFECTIVE FROM MANUFACTURER
+5 ;;PATIENT REQUESTED DELAY OR RESCHEDULED ORIGINAL APPT
+6 ;;CLINIC RESCHEDULED ORIGINAL APPOINTMENT
+7 ;;HEARING AID NOT RECEIVED IN TIME FOR HAE
+8 ;;NO AVAILABLE APPOINTMENT W/I 40 WORKING DAYS
+9 ;;MEDICAL CLEARANCE REQUIRED
