MMRSIPCP ;MIA/LMT/TCK,LAB - SETUP MDRO TOOLS SOFTWARE PARAMETERS ;May 22, 2019@09:15:23
;;1.0;MRSA PROGRAM TOOLS;**1,3,4,8,9**;Mar 22, 2009;Build 1
;
DIV ;Add a division and setup business rules
N DIC,X,DINUM,DLAYGO,MMRSDIV,DIR,DIE,DA,DR,DIDEL,Y
S DIC="^MMRS(104,"
S DIC(0)="AELMQ"
S DIC("A")="Select MRSA Site Parameters Division: "
S DLAYGO=104
D ^DIC
K DLAYGO
I $D(DTOUT)!($D(DUOUT))!(Y=-1) S EXTFLG=1 Q
S MMRSDIV=+Y
W !!
;RECEIVING UNIT SCREEN
S DA=MMRSDIV
S DIR("A")="1. Receiving unit screen on unit-to-unit transfers"
S DIR(0)="104,1"
D ^DIR
I $D(DTOUT)!($D(DUOUT)) S EXTFLG=1 Q
S DIE="^MMRS(104,"
S DA=MMRSDIV
S Y=+$P(Y,U,1)
S DR="1///"_Y ;MMRS*1.0*8
I Y=1!(Y=0) D ^DIE
;DISCHARGING UNIT SCREEN
S DA=MMRSDIV
S DIR("A")="2. Discharging unit screen on unit-to-unit transfers"
S DIR(0)="104,2"
D ^DIR
I $D(DTOUT)!($D(DUOUT)) S EXTFLG=1 Q
S DIE="^MMRS(104,"
S DA=MMRSDIV
S Y=+$P(Y,U,1)
S DR="2///"_Y ;MMRS*1.0*8
I Y=1!(Y=0) D ^DIE
;SCREEN POS ON TRANSFER IN
S DA=MMRSDIV
S DIR("A")="3. Screen patients with MRSA history on transfer-in"
S DIR(0)="104,3"
D ^DIR
I $D(DTOUT)!($D(DUOUT)) S EXTFLG=1 Q
S DIE="^MMRS(104,"
S DA=MMRSDIV
S Y=+$P(Y,U,1)
S DR="3///"_Y ;MMRS*1.0*8
I Y=1!(Y=0) D ^DIE
;SCREEN POS ON DISCHARGE
S DA=MMRSDIV
S DIR("A")="4. Screen patients with MRSA history on discharge/death/transfer-out"
S DIR(0)="104,4"
D ^DIR
I $D(DTOUT)!($D(DUOUT)) S EXTFLG=1 Q
S DIE="^MMRS(104,"
S DA=MMRSDIV
S Y=+$P(Y,U,1)
S DR="4///"_Y ;MMRS*1.0*8
I Y=1!(Y=0) D ^DIE
Q
;
FLESPC ;
;Add a division and setup business rules
N DIC,X,DINUM,DLAYGO,MMRSDIV,DIR,DIE,DA,DR,DIDEL,Y
S DIC="^MMRS(104,"
S DIC(0)="AELMQ"
S DIC("A")="Select CRE Site Parameters Division: "
S DLAYGO=104
D ^DIC
K DLAYGO
I $D(DTOUT)!($D(DUOUT))!(Y=-1) S EXTFLG=1 Q
S MMRSDIV=+Y
W !!
;ADD SURVEILLANCE SCREEN SPECIMENS
N STID,STNM,SIEN
S DIR(0)="YA",DIR("A")="Do you want to Add or Edit specimen(s) for CRE Surveillance Screens"
S DIR(0)="S^A:ADD;E:EDIT"
S DIR("B")="E"
D ^DIR
Q:X=""!($D(DIRUT))!($D(DIROUT))
;I $D(DIRUT) S EXTFLG=1 Q
I Y Q
S STOP=0
N DIC,DLAYGO,DTOUT,DUOUT,EXTFLG
S EXTFLG=0
G:Y="A" ADD
;
DEL ;
S EXTFLG=0
W !
S DA(1)=MMRSDIV
K DIR S DIR("A")="Select Specimen to delete"
S DIR("?")="Enter the specimen you want to edit"
S DIR(0)="PO^MMRS(104,DA(1),61,:QEMO"
D ^DIR
I Y["^" D
.S DA(1)=MMRSDIV
.S DA=$P(Y,"^")
.S DIK="^MMRS(104,"_DA(1)_",61,"
.D ^DIK
I $P(Y,"^",2)'="" G DEL
K DIK,DA
Q
;
ADD ;
K DIR S DIR("A")="Select Specimen"
S DIR(0)="P^61:QEM"
S DA(1)=MMRSDIV
D ^DIR
I (Y=-1)!($D(DTOUT))!($D(DUOUT)) S EXTFLG=1 Q
S X=$P(Y,"^"),VAL=X
I $D(^MMRS(104,"AC",DA(1),X)) D G FLESPC
.W !!!!,$P(Y,"^",2)_" already exists." H 1 Q
S IEN="?+1,"_DA(1)_","
S LRFDA(61,104.0216061,IEN,.01)=VAL
D UPDATE^DIE("","LRFDA(61)","","LRMSG")
I 'EXTFLG G FLESPC
Q
;
;
LAB ;Entry to setup the Lab Search/Extract Parameters
N EXTFLG,MMRSDIV,MDRO,DA,DO,DIC,DINUM,X,Y,DDSFILE,DR,DDSPAGE,DDSPARAM,DIR
D CHECK^MMRSIPC
I $D(EXTFLG) W ! H 2 Q
W !
S MMRSDIV=$$GETDIV^MMRSIPC Q:$D(EXTFLG)!(MMRSDIV="")
W !
S MDRO=$$GETMDRO Q:$D(EXTFLG)
W !
S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to see a description for "_$$GET1^DIQ(104.2,MDRO,.01)
D ^DIR
I $D(DTOUT)!($D(DUOUT)) S EXTFLG=1 Q
I Y=1 D
.N DIC,DA,DR,DIQ,DIR
.W @IOF
.S DIC="^MMRS(104.2,"
.S DA=MDRO
.S DR=2
.D EN^DIQ
.S DIR(0)="E",DIR("A")="Enter RETURN to continue" D ^DIR
W !
S DA=$O(^MMRS(104.1,"C",MMRSDIV,MDRO,0))
I 'DA D Q:$D(EXTFLG)!('DA)
.K DA
.S DIC="^MMRS(104.1,"
.S DIC(0)="F"
.S X=MDRO
.S DIC("DR")="1////"_MMRSDIV ;MMRS*1.0*9
.D FILE^DICN
.I Y=-1 S EXTFLG=1 Q
.S DA=+Y
S DDSFILE="^MMRS(104.1,"
S DR="[MMRSLABPARAM]"
D ^DDS
Q
GETMDRO() ;
N MDRO,DIC,DLAYGO,DINUM,Y,DLAYGO,X,DTOUT,DUOUT
S MDRO=""
S DIC="^MMRS(104.2,"
S DIC(0)="AEMNQ"
S DIC("A")="Select the MDRO: "
D ^DIC K DIC
I $D(DTOUT)!($D(DUOUT))!(Y=-1) S EXTFLG=1 Q ""
S MDRO=+Y
Q MDRO
WARDMAP ;Entry to setup the Ward Mappings
N MMRSDIV,DIC,Y,DLAYGO,DINUM,X,DTOUT,DUOUT,DDSFILE,DR,DA,DDSPAGE,DDSPARAM,EXTFLG,DIE,DIDEL,MMRSDA
D CHECK^MMRSIPC
I $D(EXTFLG) W ! H 2 Q
W !
S MMRSDIV=$$GETDIV^MMRSIPC Q:$D(EXTFLG)!(MMRSDIV="")
F Q:$D(EXTFLG) D
.S DIC="^MMRS(104.3,"
.S DIC(0)="AELMQ"
.S DIC("A")="Select Geographical Unit: "
.S DIC("DR")="1////"_MMRSDIV_";3;4" ;MMRS*1.0*9
.S DLAYGO=104.3
.W !! D ^DIC
.K DLAYGO
.I $D(DTOUT)!($D(DUOUT))!(Y=-1) S EXTFLG=1 Q
.S MMRSDA=+Y
.I '$P(Y,U,3) D
..S DIE="^MMRS(104.3,"
..S DA=MMRSDA
..S DR=".01;3;4"
..S DIDEL=104.3
..W !
..D ^DIE
..I $D(DTOUT)!('$D(DA)) S EXTFLG=1 Q
.Q:$D(EXTFLG)
.S DDSFILE="^MMRS(104.3,"
.S DR="[MMRSMRSA WARD MAP]"
.S DA=MMRSDA
.D ^DDS
.W @IOF
Q
HISTDAY ;Historical Days Edit
N EXTFLG,MMRSDIV,MDRO,DA,DO,DIC,DINUM,X,Y,DIR,NUMDAY,MMRSX,DIE,DR,DIDEL,DIRUT,DTOUT,DUOUT
D CHECK^MMRSIPC
I $D(EXTFLG) W ! H 2 Q
W ! S MMRSDIV=$$GETDIV^MMRSIPC Q:$D(EXTFLG)!(MMRSDIV="")
W !
S MDRO=0 F S MDRO=$O(^MMRS(104.2,MDRO)) Q:'MDRO D Q:$D(EXTFLG)
.S DA=$O(^MMRS(104.2,MDRO,1,"B",MMRSDIV,0))
.I 'DA D Q:$D(EXTFLG)!('DA)
..K DA
..S DIC="^MMRS(104.2,"_MDRO_",1,"
..S DIC(0)="F"
..S DA(1)=MDRO
..S X=MMRSDIV
..D FILE^DICN
..I Y=-1 S EXTFLG=1 Q
..S DA=+Y
.S DA(1)=MDRO
.S DIR(0)="104.22,1^AO"
.S DIR("PRE")="I X=""@"" S X=9876 S MMRSX=9876"
.S DIR("A")="Enter the number of days to search for "_$P($G(^MMRS(104.2,MDRO,0)),U,1)
.D ^DIR
.I $D(DTOUT)!($D(DUOUT)) S EXTFLG=1 Q
.I Y D
..S DIE="^MMRS(104.2,"_MDRO_",1,"
..I $G(MMRSX)'=9876 S DR="1///"_+Y ;MMRS*1.0*8
..I Y=9876,($G(MMRSX)=9876) S DR="1////@"
..K MMRSX
..D ^DIE
..I $D(Y) S EXTFLG=1 Q ;MMRS*1.0*8
W !
Q
ISLTORD ;Entry to setup the Isolation Orders Parameters
N EXTFLG,MMRSDIV,DA,DDSFILE,DR,DDSPAGE,DDSPARAM
D CHECK^MMRSIPC
I $D(EXTFLG) W ! H 2 Q
W !
S MMRSDIV=$$GETDIV^MMRSIPC Q:$D(EXTFLG)!(MMRSDIV="")
W !
S DA=MMRSDIV
S DDSFILE="^MMRS(104,"
S DR="[MMRSISLTORD]"
D ^DDS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMMRSIPCP 6120 printed Apr 09, 2024@21:17:02 Page 2
MMRSIPCP ;MIA/LMT/TCK,LAB - SETUP MDRO TOOLS SOFTWARE PARAMETERS ;May 22, 2019@09:15:23
+1 ;;1.0;MRSA PROGRAM TOOLS;**1,3,4,8,9**;Mar 22, 2009;Build 1
+2 ;
DIV ;Add a division and setup business rules
+1 NEW DIC,X,DINUM,DLAYGO,MMRSDIV,DIR,DIE,DA,DR,DIDEL,Y
+2 SET DIC="^MMRS(104,"
+3 SET DIC(0)="AELMQ"
+4 SET DIC("A")="Select MRSA Site Parameters Division: "
+5 SET DLAYGO=104
+6 DO ^DIC
+7 KILL DLAYGO
+8 IF $DATA(DTOUT)!($DATA(DUOUT))!(Y=-1)
SET EXTFLG=1
QUIT
+9 SET MMRSDIV=+Y
+10 WRITE !!
+11 ;RECEIVING UNIT SCREEN
+12 SET DA=MMRSDIV
+13 SET DIR("A")="1. Receiving unit screen on unit-to-unit transfers"
+14 SET DIR(0)="104,1"
+15 DO ^DIR
+16 IF $DATA(DTOUT)!($DATA(DUOUT))
SET EXTFLG=1
QUIT
+17 SET DIE="^MMRS(104,"
+18 SET DA=MMRSDIV
+19 SET Y=+$PIECE(Y,U,1)
+20 ;MMRS*1.0*8
SET DR="1///"_Y
+21 IF Y=1!(Y=0)
DO ^DIE
+22 ;DISCHARGING UNIT SCREEN
+23 SET DA=MMRSDIV
+24 SET DIR("A")="2. Discharging unit screen on unit-to-unit transfers"
+25 SET DIR(0)="104,2"
+26 DO ^DIR
+27 IF $DATA(DTOUT)!($DATA(DUOUT))
SET EXTFLG=1
QUIT
+28 SET DIE="^MMRS(104,"
+29 SET DA=MMRSDIV
+30 SET Y=+$PIECE(Y,U,1)
+31 ;MMRS*1.0*8
SET DR="2///"_Y
+32 IF Y=1!(Y=0)
DO ^DIE
+33 ;SCREEN POS ON TRANSFER IN
+34 SET DA=MMRSDIV
+35 SET DIR("A")="3. Screen patients with MRSA history on transfer-in"
+36 SET DIR(0)="104,3"
+37 DO ^DIR
+38 IF $DATA(DTOUT)!($DATA(DUOUT))
SET EXTFLG=1
QUIT
+39 SET DIE="^MMRS(104,"
+40 SET DA=MMRSDIV
+41 SET Y=+$PIECE(Y,U,1)
+42 ;MMRS*1.0*8
SET DR="3///"_Y
+43 IF Y=1!(Y=0)
DO ^DIE
+44 ;SCREEN POS ON DISCHARGE
+45 SET DA=MMRSDIV
+46 SET DIR("A")="4. Screen patients with MRSA history on discharge/death/transfer-out"
+47 SET DIR(0)="104,4"
+48 DO ^DIR
+49 IF $DATA(DTOUT)!($DATA(DUOUT))
SET EXTFLG=1
QUIT
+50 SET DIE="^MMRS(104,"
+51 SET DA=MMRSDIV
+52 SET Y=+$PIECE(Y,U,1)
+53 ;MMRS*1.0*8
SET DR="4///"_Y
+54 IF Y=1!(Y=0)
DO ^DIE
+55 QUIT
+56 ;
FLESPC ;
+1 ;Add a division and setup business rules
+2 NEW DIC,X,DINUM,DLAYGO,MMRSDIV,DIR,DIE,DA,DR,DIDEL,Y
+3 SET DIC="^MMRS(104,"
+4 SET DIC(0)="AELMQ"
+5 SET DIC("A")="Select CRE Site Parameters Division: "
+6 SET DLAYGO=104
+7 DO ^DIC
+8 KILL DLAYGO
+9 IF $DATA(DTOUT)!($DATA(DUOUT))!(Y=-1)
SET EXTFLG=1
QUIT
+10 SET MMRSDIV=+Y
+11 WRITE !!
+12 ;ADD SURVEILLANCE SCREEN SPECIMENS
+13 NEW STID,STNM,SIEN
+14 SET DIR(0)="YA"
SET DIR("A")="Do you want to Add or Edit specimen(s) for CRE Surveillance Screens"
+15 SET DIR(0)="S^A:ADD;E:EDIT"
+16 SET DIR("B")="E"
+17 DO ^DIR
+18 if X=""!($DATA(DIRUT))!($DATA(DIROUT))
QUIT
+19 ;I $D(DIRUT) S EXTFLG=1 Q
+20 IF Y
QUIT
+21 SET STOP=0
+22 NEW DIC,DLAYGO,DTOUT,DUOUT,EXTFLG
+23 SET EXTFLG=0
+24 if Y="A"
GOTO ADD
+25 ;
DEL ;
+1 SET EXTFLG=0
+2 WRITE !
+3 SET DA(1)=MMRSDIV
+4 KILL DIR
SET DIR("A")="Select Specimen to delete"
+5 SET DIR("?")="Enter the specimen you want to edit"
+6 SET DIR(0)="PO^MMRS(104,DA(1),61,:QEMO"
+7 DO ^DIR
+8 IF Y["^"
Begin DoDot:1
+9 SET DA(1)=MMRSDIV
+10 SET DA=$PIECE(Y,"^")
+11 SET DIK="^MMRS(104,"_DA(1)_",61,"
+12 DO ^DIK
End DoDot:1
+13 IF $PIECE(Y,"^",2)'=""
GOTO DEL
+14 KILL DIK,DA
+15 QUIT
+16 ;
ADD ;
+1 KILL DIR
SET DIR("A")="Select Specimen"
+2 SET DIR(0)="P^61:QEM"
+3 SET DA(1)=MMRSDIV
+4 DO ^DIR
+5 IF (Y=-1)!($DATA(DTOUT))!($DATA(DUOUT))
SET EXTFLG=1
QUIT
+6 SET X=$PIECE(Y,"^")
SET VAL=X
+7 IF $DATA(^MMRS(104,"AC",DA(1),X))
Begin DoDot:1
+8 WRITE !!!!,$PIECE(Y,"^",2)_" already exists."
HANG 1
QUIT
End DoDot:1
GOTO FLESPC
+9 SET IEN="?+1,"_DA(1)_","
+10 SET LRFDA(61,104.0216061,IEN,.01)=VAL
+11 DO UPDATE^DIE("","LRFDA(61)","","LRMSG")
+12 IF 'EXTFLG
GOTO FLESPC
+13 QUIT
+14 ;
+15 ;
LAB ;Entry to setup the Lab Search/Extract Parameters
+1 NEW EXTFLG,MMRSDIV,MDRO,DA,DO,DIC,DINUM,X,Y,DDSFILE,DR,DDSPAGE,DDSPARAM,DIR
+2 DO CHECK^MMRSIPC
+3 IF $DATA(EXTFLG)
WRITE !
HANG 2
QUIT
+4 WRITE !
+5 SET MMRSDIV=$$GETDIV^MMRSIPC
if $DATA(EXTFLG)!(MMRSDIV="")
QUIT
+6 WRITE !
+7 SET MDRO=$$GETMDRO
if $DATA(EXTFLG)
QUIT
+8 WRITE !
+9 SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Do you want to see a description for "_$$GET1^DIQ(104.2,MDRO,.01)
+10 DO ^DIR
+11 IF $DATA(DTOUT)!($DATA(DUOUT))
SET EXTFLG=1
QUIT
+12 IF Y=1
Begin DoDot:1
+13 NEW DIC,DA,DR,DIQ,DIR
+14 WRITE @IOF
+15 SET DIC="^MMRS(104.2,"
+16 SET DA=MDRO
+17 SET DR=2
+18 DO EN^DIQ
+19 SET DIR(0)="E"
SET DIR("A")="Enter RETURN to continue"
DO ^DIR
End DoDot:1
+20 WRITE !
+21 SET DA=$ORDER(^MMRS(104.1,"C",MMRSDIV,MDRO,0))
+22 IF 'DA
Begin DoDot:1
+23 KILL DA
+24 SET DIC="^MMRS(104.1,"
+25 SET DIC(0)="F"
+26 SET X=MDRO
+27 ;MMRS*1.0*9
SET DIC("DR")="1////"_MMRSDIV
+28 DO FILE^DICN
+29 IF Y=-1
SET EXTFLG=1
QUIT
+30 SET DA=+Y
End DoDot:1
if $DATA(EXTFLG)!('DA)
QUIT
+31 SET DDSFILE="^MMRS(104.1,"
+32 SET DR="[MMRSLABPARAM]"
+33 DO ^DDS
+34 QUIT
GETMDRO() ;
+1 NEW MDRO,DIC,DLAYGO,DINUM,Y,DLAYGO,X,DTOUT,DUOUT
+2 SET MDRO=""
+3 SET DIC="^MMRS(104.2,"
+4 SET DIC(0)="AEMNQ"
+5 SET DIC("A")="Select the MDRO: "
+6 DO ^DIC
KILL DIC
+7 IF $DATA(DTOUT)!($DATA(DUOUT))!(Y=-1)
SET EXTFLG=1
QUIT ""
+8 SET MDRO=+Y
+9 QUIT MDRO
WARDMAP ;Entry to setup the Ward Mappings
+1 NEW MMRSDIV,DIC,Y,DLAYGO,DINUM,X,DTOUT,DUOUT,DDSFILE,DR,DA,DDSPAGE,DDSPARAM,EXTFLG,DIE,DIDEL,MMRSDA
+2 DO CHECK^MMRSIPC
+3 IF $DATA(EXTFLG)
WRITE !
HANG 2
QUIT
+4 WRITE !
+5 SET MMRSDIV=$$GETDIV^MMRSIPC
if $DATA(EXTFLG)!(MMRSDIV="")
QUIT
+6 FOR
if $DATA(EXTFLG)
QUIT
Begin DoDot:1
+7 SET DIC="^MMRS(104.3,"
+8 SET DIC(0)="AELMQ"
+9 SET DIC("A")="Select Geographical Unit: "
+10 ;MMRS*1.0*9
SET DIC("DR")="1////"_MMRSDIV_";3;4"
+11 SET DLAYGO=104.3
+12 WRITE !!
DO ^DIC
+13 KILL DLAYGO
+14 IF $DATA(DTOUT)!($DATA(DUOUT))!(Y=-1)
SET EXTFLG=1
QUIT
+15 SET MMRSDA=+Y
+16 IF '$PIECE(Y,U,3)
Begin DoDot:2
+17 SET DIE="^MMRS(104.3,"
+18 SET DA=MMRSDA
+19 SET DR=".01;3;4"
+20 SET DIDEL=104.3
+21 WRITE !
+22 DO ^DIE
+23 IF $DATA(DTOUT)!('$DATA(DA))
SET EXTFLG=1
QUIT
End DoDot:2
+24 if $DATA(EXTFLG)
QUIT
+25 SET DDSFILE="^MMRS(104.3,"
+26 SET DR="[MMRSMRSA WARD MAP]"
+27 SET DA=MMRSDA
+28 DO ^DDS
+29 WRITE @IOF
End DoDot:1
+30 QUIT
HISTDAY ;Historical Days Edit
+1 NEW EXTFLG,MMRSDIV,MDRO,DA,DO,DIC,DINUM,X,Y,DIR,NUMDAY,MMRSX,DIE,DR,DIDEL,DIRUT,DTOUT,DUOUT
+2 DO CHECK^MMRSIPC
+3 IF $DATA(EXTFLG)
WRITE !
HANG 2
QUIT
+4 WRITE !
SET MMRSDIV=$$GETDIV^MMRSIPC
if $DATA(EXTFLG)!(MMRSDIV="")
QUIT
+5 WRITE !
+6 SET MDRO=0
FOR
SET MDRO=$ORDER(^MMRS(104.2,MDRO))
if 'MDRO
QUIT
Begin DoDot:1
+7 SET DA=$ORDER(^MMRS(104.2,MDRO,1,"B",MMRSDIV,0))
+8 IF 'DA
Begin DoDot:2
+9 KILL DA
+10 SET DIC="^MMRS(104.2,"_MDRO_",1,"
+11 SET DIC(0)="F"
+12 SET DA(1)=MDRO
+13 SET X=MMRSDIV
+14 DO FILE^DICN
+15 IF Y=-1
SET EXTFLG=1
QUIT
+16 SET DA=+Y
End DoDot:2
if $DATA(EXTFLG)!('DA)
QUIT
+17 SET DA(1)=MDRO
+18 SET DIR(0)="104.22,1^AO"
+19 SET DIR("PRE")="I X=""@"" S X=9876 S MMRSX=9876"
+20 SET DIR("A")="Enter the number of days to search for "_$PIECE($GET(^MMRS(104.2,MDRO,0)),U,1)
+21 DO ^DIR
+22 IF $DATA(DTOUT)!($DATA(DUOUT))
SET EXTFLG=1
QUIT
+23 IF Y
Begin DoDot:2
+24 SET DIE="^MMRS(104.2,"_MDRO_",1,"
+25 ;MMRS*1.0*8
IF $GET(MMRSX)'=9876
SET DR="1///"_+Y
+26 IF Y=9876
IF ($GET(MMRSX)=9876)
SET DR="1////@"
+27 KILL MMRSX
+28 DO ^DIE
+29 ;MMRS*1.0*8
IF $DATA(Y)
SET EXTFLG=1
QUIT
End DoDot:2
End DoDot:1
if $DATA(EXTFLG)
QUIT
+30 WRITE !
+31 QUIT
ISLTORD ;Entry to setup the Isolation Orders Parameters
+1 NEW EXTFLG,MMRSDIV,DA,DDSFILE,DR,DDSPAGE,DDSPARAM
+2 DO CHECK^MMRSIPC
+3 IF $DATA(EXTFLG)
WRITE !
HANG 2
QUIT
+4 WRITE !
+5 SET MMRSDIV=$$GETDIV^MMRSIPC
if $DATA(EXTFLG)!(MMRSDIV="")
QUIT
+6 WRITE !
+7 SET DA=MMRSDIV
+8 SET DDSFILE="^MMRS(104,"
+9 SET DR="[MMRSISLTORD]"
+10 DO ^DDS
+11 QUIT
