- 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 Feb 19, 2025@00:03:11 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