source: FOIAVistA/tag/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFPRE.m@ 628

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