ORCMEDT5 ;SLC/MKB-Misc menu utilities ;03:29 PM 12 Feb 1999
;;3.0;ORDER ENTRY/RESULTS REPORTING;**8,46,296,314,375**;Dec 17, 1997;Build 1
SEARCH ; -- Search/replace menu items
N ORDLG
F S ORDLG=$$DIC Q:ORDLG'>0 D SR1(ORDLG) W !!
Q
;
SR1(ORX) ; -- list parents, get replacement
N CNT,DA,DR,DIE,DIK,I,J,ORDAD,ORY,ORNMBR,NUM,ORI,ORDAD,ORNM
I '$O(^ORD(101.41,"AD",+ORX,0)) W !,$P(ORX,U,2)_" has no menu items." Q
W @IOF,"Menu items of "_$P(ORX,U,2),!?4,"Name",?69,"Type",!,$$REPEAT^XLFSTR("-",79)
S (I,ORDAD)=0 F S I=$O(^ORD(101.41,"AD",+ORX,I)) Q:I'>0 D
. S J=0 F S J=$O(^ORD(101.41,"AD",+ORX,I,J)) Q:J'>0 D
. . S ORDAD=ORDAD+1,ORDAD(ORDAD)=I_U_J
. . W !,ORDAD,?4,$P(^ORD(101.41,I,0),U),?69,$$TYPE($P(^(0),U,4))
W !,$$REPEAT^XLFSTR("-",79)
S ORY=$$REPLWITH(ORX) Q:ORY="^"
D SELECT(ORY,ORDAD,.ORNMBR) Q:ORNMBR="^"
Q:'$$OK W !!,$S(ORY="@":"Removing",1:"Replacing "_$P(ORX,U,2)_" with "_$P(ORY,U,2))_" in:"
S CNT="" F S CNT=$O(ORNMBR(CNT)) Q:CNT="" D
. D LOOP($G(ORNMBR(CNT)))
Q
LOOP(ORNMBR) ;
F ORI=1:1:$L(ORNMBR,",") S NUM=$P(ORNMBR,",",ORI) I NUM D
. S DA(1)=+ORDAD(NUM),DA=$P(ORDAD(NUM),U,2),DIE="^ORD(101.41,"_DA(1)_",10,"
. S ORDAD=DA(1),ORNM=$P(^ORD(101.41,ORDAD,0),U) W !?3,ORNM_" ..."
. I '$$VALID(ORY,ORDAD,.ORERR) D Q
. . W "not "_$S(ORY="@":"removed.",1:"changed."),!?3,">> "_$G(ORERR)
. . S I=0 F S I=$O(ORERR(I)) Q:I'>0 W !?25,"=>"_ORERR(I)
. I ORY="@" S DIK=DIE D ^DIK W "done." Q
. S DR="2////"_+ORY D ^DIE W $S($P(^ORD(101.41,DA(1),10,DA,0),U,2)=+ORY:"done.",1:"error - not replaced.")
Q
;
TYPE(X) ; -- Returns name of dialog type
N Y S Y=$S(X="P":"prompt",X="D":"dialog",X="Q":"quick order",X="O":"order set",X="M":"menu",X="A":"action",1:"")
Q Y
;
DIC() ; -- ^DIC on Order Dialog file
N X,Y,DIC
S DIC=101.41,DIC(0)="AEQM",DIC("A")="Search for: "
S DIC("?")="Enter the name of the dialog component you wish to search for."
D ^DIC
Q Y
;
SELECT(ORY,MAX,Y) ; -- Select which Dlgs to replace items
N X,DIR
S DIR(0)="LA^1:"_MAX,DIR("A")=$S(ORY="@":"Remove in: ",1:"Replace in: "),DIR("B")=$S(MAX>1:"1-"_MAX,1:"1")
; S DIR("?")
D ^DIR S:$D(DTOUT)!(X["^") Y="^"
Q
;
OK() ; -- Are you ready?
N X,Y,DIR
S DIR(0)="YA",DIR("A")="Are you ready? ",DIR("B")="NO"
W ! D ^DIR
Q +Y
;
REPLWITH(ORIT) ; -- Remove item, or select replacement
N X,Y,DIR,DIC
S DIR(0)="FAO^1:63",DIR("A")="Replace "_$P(ORIT,U,2)_" with: "
S DIR("?")="Enter the name of the item you wish to replace this one with, or @ to remove this item; to quit without changing anything, press <return>."
R1 D ^DIR I X="@" Q "@"
I $D(DTOUT)!("^"[X) Q "^"
S DIC=101.41,DIC(0)="EQM" D ^DIC I Y'>0 G R1
Q Y
;
VALID(ITM,DAD,ERR) ; -- Ck if ITM may be placed on DAD
N DTYPE,ITYPE,Y S Y=0
S DTYPE=$P(^ORD(101.41,DAD,0),U,4) I DTYPE="D",$$NMSP^ORCD($P(^(0),U,7))'="OR" S ERR="Only generic ordering dialogs are editable." G VQ
I ITM="@" S Y=1 G VQ ; ok to delete
S ITYPE=$P(^ORD(101.41,+ITM,0),U,4)
I ITYPE="P",DTYPE'="D" S ERR="A prompt may not be added to a "_$$TYPE(DTYPE)_"." G VQ
I ITYPE="A","DOM"'[DTYPE S ERR="An action may not be added to a "_$$TYPE(DTYPE)_"." G VQ
I "DQOM"[ITYPE,"OM"'[DTYPE S ERR="A "_$$TYPE(ITYPE)_" may not be added to a "_$$TYPE(DTYPE)_"." G VQ
D RECURSV(+ITM,DAD,.ERR) I $D(ERR) S Y=0 G VQ
S Y=1 ; ok
VQ Q Y
;
RECURSV(ITEM,MENU,MSG) ; -- Return 1 or 0, if recursive reference to ITEM
N STACK,CNT S STACK=0,CNT=0
K MSG
I ITEM=MENU S MSG="Recursive Reference: "_$P($G(^ORD(101.41,ITEM,0)),U) Q ;p375 prevents menu on itself
D CHKPAR(MENU)
Q
CHKPAR(MENU) ; follow tree to check parents
N PMENU,I
S STACK=STACK+1,STACK(STACK)=MENU,STACK("B",MENU)=STACK,PMENU=0
F S PMENU=$O(^ORD(101.41,"AD",MENU,PMENU)) Q:'PMENU D Q:$D(MSG)
. I PMENU=ITEM D Q
. . S MSG="Recursive Reference: "_$P(^ORD(101.41,ITEM,0),U)
. . F I=STACK:-1:1 S CNT=CNT+1,MSG(CNT)=$P(^ORD(101.41,STACK(I),0),U)
. I $D(STACK("B",PMENU)) Q
. D CHKPAR(PMENU)
K STACK(STACK) S STACK=STACK-1
Q
;
INUSE(MENU) ; -- Returns 1 or 0, if MENU is in use by parameter
N PARAM,ENT,Y
S PARAM=$O(^XTV(8989.51,"B","OR ADD ORDERS MENU",0)),Y=0
S ENT="" F S ENT=$O(^XTV(8989.5,"AC",PARAM,ENT)) Q:ENT="" I $G(^(ENT,1))=MENU S Y=1 Q
Q Y
;
ASSIGN ; -- Assign menu to user(s)
D FULL^VALM1
D EDITPAR^XPAREDIT("OR ADD ORDERS MENU")
S VALMBCK="R"
Q
;
INQ ; -- Inquire to Order Dialog file
N X,Y,DIC,DA,DR,DIQ
S DIC="^ORD(101.41,",DIC(0)="AEQM"
F D ^DIC Q:Y'>0 S DA=+Y W ! D EN^DIQ W !
Q
;
OUTPUT(ORY) ; -- Output Xform for Value field of Response multiple
N ORDIALOG,ORP,ORZ S ORZ=ORY
S ORP=$P($G(^ORD(101.41,D0,6,D1,0)),U,2)
I ORP S ORDIALOG(ORP,0)=$P($G(^ORD(101.41,ORP,1)),U,1,2),ORDIALOG(ORP,1)=ORY,ORZ=$$EXT^ORCD(ORP,1)
Q ORZ
;
AOPAR ; -- List of add order menus assigned to users
N BY,DHD,DIC,FLDS,FR,TO
S DIC=8989.5
S FR="OR ADD ORDERS MENU,?",TO="OR ADD ORDERS MENU,?"
S BY="@.02,@1;S2;""Add order menu: """
S DHD="CPRS Add order menu list"
S FLDS="VALUE;N;""Menu"",ENTITY;""User/Location/etc."";C40"
D EN1^DIP
Q
;
DISABLE ; -- Disable order dialogs
N X,Y,DIC,DIR,ORDIS,ORI K ^TMP("ORDISABLE",$J)
S DIC=101.41,DIC(0)="AEQM",DIC("A")="Select ORDER DIALOG: ",DIC("?")="Enter the name of an order dialog you wish to disable."
S DIC("W")="I $L($P(^(0),U,3)) W !?3,"">> disabled: ""_$P(^(0),U,3)"
F D ^DIC Q:Y'>0 S ^TMP("ORDISABLE",$J,+Y)="" S DIC("A")="ANOTHER ONE: "
Q:'$O(^TMP("ORDISABLE",$J,0)) ;none selected
W !!,"Enter a message to disable the dialog(s), or @ to enable again."
S DIR(0)="FAO^1:40",DIR("A")="MESSAGE: "
S DIR("?")="Enter up to 40 characters explaining why use of this dialog has been disabled that will display if the dialog is selected, or @ to enable the dialog again."
D ^DIR G:$D(DTOUT)!$D(DUOUT)!(X="") DQ S ORDIS=X
I '$$OK W !,"Nothing "_$S(ORDIS="@":"en",1:"dis")_"abled." H 1 G DQ
S ORI=0 F S ORI=$O(^TMP("ORDISABLE",$J,ORI)) Q:ORI'>0 S $P(^ORD(101.41,ORI,0),U,3)=$S(ORDIS="@":"",1:ORDIS) W "."
W !,"done." H 1
DQ K ^TMP("ORDISABLE",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCMEDT5 6087 printed Dec 13, 2024@02:28:39 Page 2
ORCMEDT5 ;SLC/MKB-Misc menu utilities ;03:29 PM 12 Feb 1999
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**8,46,296,314,375**;Dec 17, 1997;Build 1
SEARCH ; -- Search/replace menu items
+1 NEW ORDLG
+2 FOR
SET ORDLG=$$DIC
if ORDLG'>0
QUIT
DO SR1(ORDLG)
WRITE !!
+3 QUIT
+4 ;
SR1(ORX) ; -- list parents, get replacement
+1 NEW CNT,DA,DR,DIE,DIK,I,J,ORDAD,ORY,ORNMBR,NUM,ORI,ORDAD,ORNM
+2 IF '$ORDER(^ORD(101.41,"AD",+ORX,0))
WRITE !,$PIECE(ORX,U,2)_" has no menu items."
QUIT
+3 WRITE @IOF,"Menu items of "_$PIECE(ORX,U,2),!?4,"Name",?69,"Type",!,$$REPEAT^XLFSTR("-",79)
+4 SET (I,ORDAD)=0
FOR
SET I=$ORDER(^ORD(101.41,"AD",+ORX,I))
if I'>0
QUIT
Begin DoDot:1
+5 SET J=0
FOR
SET J=$ORDER(^ORD(101.41,"AD",+ORX,I,J))
if J'>0
QUIT
Begin DoDot:2
+6 SET ORDAD=ORDAD+1
SET ORDAD(ORDAD)=I_U_J
+7 WRITE !,ORDAD,?4,$PIECE(^ORD(101.41,I,0),U),?69,$$TYPE($PIECE(^(0),U,4))
End DoDot:2
End DoDot:1
+8 WRITE !,$$REPEAT^XLFSTR("-",79)
+9 SET ORY=$$REPLWITH(ORX)
if ORY="^"
QUIT
+10 DO SELECT(ORY,ORDAD,.ORNMBR)
if ORNMBR="^"
QUIT
+11 if '$$OK
QUIT
WRITE !!,$SELECT(ORY="@":"Removing",1:"Replacing "_$PIECE(ORX,U,2)_" with "_$PIECE(ORY,U,2))_" in:"
+12 SET CNT=""
FOR
SET CNT=$ORDER(ORNMBR(CNT))
if CNT=""
QUIT
Begin DoDot:1
+13 DO LOOP($GET(ORNMBR(CNT)))
End DoDot:1
+14 QUIT
LOOP(ORNMBR) ;
+1 FOR ORI=1:1:$LENGTH(ORNMBR,",")
SET NUM=$PIECE(ORNMBR,",",ORI)
IF NUM
Begin DoDot:1
+2 SET DA(1)=+ORDAD(NUM)
SET DA=$PIECE(ORDAD(NUM),U,2)
SET DIE="^ORD(101.41,"_DA(1)_",10,"
+3 SET ORDAD=DA(1)
SET ORNM=$PIECE(^ORD(101.41,ORDAD,0),U)
WRITE !?3,ORNM_" ..."
+4 IF '$$VALID(ORY,ORDAD,.ORERR)
Begin DoDot:2
+5 WRITE "not "_$SELECT(ORY="@":"removed.",1:"changed."),!?3,">> "_$GET(ORERR)
+6 SET I=0
FOR
SET I=$ORDER(ORERR(I))
if I'>0
QUIT
WRITE !?25,"=>"_ORERR(I)
End DoDot:2
QUIT
+7 IF ORY="@"
SET DIK=DIE
DO ^DIK
WRITE "done."
QUIT
+8 SET DR="2////"_+ORY
DO ^DIE
WRITE $SELECT($PIECE(^ORD(101.41,DA(1),10,DA,0),U,2)=+ORY:"done.",1:"error - not replaced.")
End DoDot:1
+9 QUIT
+10 ;
TYPE(X) ; -- Returns name of dialog type
+1 NEW Y
SET Y=$SELECT(X="P":"prompt",X="D":"dialog",X="Q":"quick order",X="O":"order set",X="M":"menu",X="A":"action",1:"")
+2 QUIT Y
+3 ;
DIC() ; -- ^DIC on Order Dialog file
+1 NEW X,Y,DIC
+2 SET DIC=101.41
SET DIC(0)="AEQM"
SET DIC("A")="Search for: "
+3 SET DIC("?")="Enter the name of the dialog component you wish to search for."
+4 DO ^DIC
+5 QUIT Y
+6 ;
SELECT(ORY,MAX,Y) ; -- Select which Dlgs to replace items
+1 NEW X,DIR
+2 SET DIR(0)="LA^1:"_MAX
SET DIR("A")=$SELECT(ORY="@":"Remove in: ",1:"Replace in: ")
SET DIR("B")=$SELECT(MAX>1:"1-"_MAX,1:"1")
+3 ; S DIR("?")
+4 DO ^DIR
if $DATA(DTOUT)!(X["^")
SET Y="^"
+5 QUIT
+6 ;
OK() ; -- Are you ready?
+1 NEW X,Y,DIR
+2 SET DIR(0)="YA"
SET DIR("A")="Are you ready? "
SET DIR("B")="NO"
+3 WRITE !
DO ^DIR
+4 QUIT +Y
+5 ;
REPLWITH(ORIT) ; -- Remove item, or select replacement
+1 NEW X,Y,DIR,DIC
+2 SET DIR(0)="FAO^1:63"
SET DIR("A")="Replace "_$PIECE(ORIT,U,2)_" with: "
+3 SET DIR("?")="Enter the name of the item you wish to replace this one with, or @ to remove this item; to quit without changing anything, press <return>."
R1 DO ^DIR
IF X="@"
QUIT "@"
+1 IF $DATA(DTOUT)!("^"[X)
QUIT "^"
+2 SET DIC=101.41
SET DIC(0)="EQM"
DO ^DIC
IF Y'>0
GOTO R1
+3 QUIT Y
+4 ;
VALID(ITM,DAD,ERR) ; -- Ck if ITM may be placed on DAD
+1 NEW DTYPE,ITYPE,Y
SET Y=0
+2 SET DTYPE=$PIECE(^ORD(101.41,DAD,0),U,4)
IF DTYPE="D"
IF $$NMSP^ORCD($PIECE(^(0),U,7))'="OR"
SET ERR="Only generic ordering dialogs are editable."
GOTO VQ
+3 ; ok to delete
IF ITM="@"
SET Y=1
GOTO VQ
+4 SET ITYPE=$PIECE(^ORD(101.41,+ITM,0),U,4)
+5 IF ITYPE="P"
IF DTYPE'="D"
SET ERR="A prompt may not be added to a "_$$TYPE(DTYPE)_"."
GOTO VQ
+6 IF ITYPE="A"
IF "DOM"'[DTYPE
SET ERR="An action may not be added to a "_$$TYPE(DTYPE)_"."
GOTO VQ
+7 IF "DQOM"[ITYPE
IF "OM"'[DTYPE
SET ERR="A "_$$TYPE(ITYPE)_" may not be added to a "_$$TYPE(DTYPE)_"."
GOTO VQ
+8 DO RECURSV(+ITM,DAD,.ERR)
IF $DATA(ERR)
SET Y=0
GOTO VQ
+9 ; ok
SET Y=1
VQ QUIT Y
+1 ;
RECURSV(ITEM,MENU,MSG) ; -- Return 1 or 0, if recursive reference to ITEM
+1 NEW STACK,CNT
SET STACK=0
SET CNT=0
+2 KILL MSG
+3 ;p375 prevents menu on itself
IF ITEM=MENU
SET MSG="Recursive Reference: "_$PIECE($GET(^ORD(101.41,ITEM,0)),U)
QUIT
+4 DO CHKPAR(MENU)
+5 QUIT
CHKPAR(MENU) ; follow tree to check parents
+1 NEW PMENU,I
+2 SET STACK=STACK+1
SET STACK(STACK)=MENU
SET STACK("B",MENU)=STACK
SET PMENU=0
+3 FOR
SET PMENU=$ORDER(^ORD(101.41,"AD",MENU,PMENU))
if 'PMENU
QUIT
Begin DoDot:1
+4 IF PMENU=ITEM
Begin DoDot:2
+5 SET MSG="Recursive Reference: "_$PIECE(^ORD(101.41,ITEM,0),U)
+6 FOR I=STACK:-1:1
SET CNT=CNT+1
SET MSG(CNT)=$PIECE(^ORD(101.41,STACK(I),0),U)
End DoDot:2
QUIT
+7 IF $DATA(STACK("B",PMENU))
QUIT
+8 DO CHKPAR(PMENU)
End DoDot:1
if $DATA(MSG)
QUIT
+9 KILL STACK(STACK)
SET STACK=STACK-1
+10 QUIT
+11 ;
INUSE(MENU) ; -- Returns 1 or 0, if MENU is in use by parameter
+1 NEW PARAM,ENT,Y
+2 SET PARAM=$ORDER(^XTV(8989.51,"B","OR ADD ORDERS MENU",0))
SET Y=0
+3 SET ENT=""
FOR
SET ENT=$ORDER(^XTV(8989.5,"AC",PARAM,ENT))
if ENT=""
QUIT
IF $GET(^(ENT,1))=MENU
SET Y=1
QUIT
+4 QUIT Y
+5 ;
ASSIGN ; -- Assign menu to user(s)
+1 DO FULL^VALM1
+2 DO EDITPAR^XPAREDIT("OR ADD ORDERS MENU")
+3 SET VALMBCK="R"
+4 QUIT
+5 ;
INQ ; -- Inquire to Order Dialog file
+1 NEW X,Y,DIC,DA,DR,DIQ
+2 SET DIC="^ORD(101.41,"
SET DIC(0)="AEQM"
+3 FOR
DO ^DIC
if Y'>0
QUIT
SET DA=+Y
WRITE !
DO EN^DIQ
WRITE !
+4 QUIT
+5 ;
OUTPUT(ORY) ; -- Output Xform for Value field of Response multiple
+1 NEW ORDIALOG,ORP,ORZ
SET ORZ=ORY
+2 SET ORP=$PIECE($GET(^ORD(101.41,D0,6,D1,0)),U,2)
+3 IF ORP
SET ORDIALOG(ORP,0)=$PIECE($GET(^ORD(101.41,ORP,1)),U,1,2)
SET ORDIALOG(ORP,1)=ORY
SET ORZ=$$EXT^ORCD(ORP,1)
+4 QUIT ORZ
+5 ;
AOPAR ; -- List of add order menus assigned to users
+1 NEW BY,DHD,DIC,FLDS,FR,TO
+2 SET DIC=8989.5
+3 SET FR="OR ADD ORDERS MENU,?"
SET TO="OR ADD ORDERS MENU,?"
+4 SET BY="@.02,@1;S2;""Add order menu: """
+5 SET DHD="CPRS Add order menu list"
+6 SET FLDS="VALUE;N;""Menu"",ENTITY;""User/Location/etc."";C40"
+7 DO EN1^DIP
+8 QUIT
+9 ;
DISABLE ; -- Disable order dialogs
+1 NEW X,Y,DIC,DIR,ORDIS,ORI
KILL ^TMP("ORDISABLE",$JOB)
+2 SET DIC=101.41
SET DIC(0)="AEQM"
SET DIC("A")="Select ORDER DIALOG: "
SET DIC("?")="Enter the name of an order dialog you wish to disable."
+3 SET DIC("W")="I $L($P(^(0),U,3)) W !?3,"">> disabled: ""_$P(^(0),U,3)"
+4 FOR
DO ^DIC
if Y'>0
QUIT
SET ^TMP("ORDISABLE",$JOB,+Y)=""
SET DIC("A")="ANOTHER ONE: "
+5 ;none selected
if '$ORDER(^TMP("ORDISABLE",$JOB,0))
QUIT
+6 WRITE !!,"Enter a message to disable the dialog(s), or @ to enable again."
+7 SET DIR(0)="FAO^1:40"
SET DIR("A")="MESSAGE: "
+8 SET DIR("?")="Enter up to 40 characters explaining why use of this dialog has been disabled that will display if the dialog is selected, or @ to enable the dialog again."
+9 DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)!(X="")
GOTO DQ
SET ORDIS=X
+10 IF '$$OK
WRITE !,"Nothing "_$SELECT(ORDIS="@":"en",1:"dis")_"abled."
HANG 1
GOTO DQ
+11 SET ORI=0
FOR
SET ORI=$ORDER(^TMP("ORDISABLE",$JOB,ORI))
if ORI'>0
QUIT
SET $PIECE(^ORD(101.41,ORI,0),U,3)=$SELECT(ORDIS="@":"",1:ORDIS)
WRITE "."
+12 WRITE !,"done."
HANG 1
DQ KILL ^TMP("ORDISABLE",$JOB)
+1 QUIT
