Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORCMEDT5

ORCMEDT5.m

Go to the documentation of this file.
  1. 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
  1. N ORDLG
  1. F S ORDLG=$$DIC Q:ORDLG'>0 D SR1(ORDLG) W !!
  1. Q
  1. ;
  1. SR1(ORX) ; -- list parents, get replacement
  1. N CNT,DA,DR,DIE,DIK,I,J,ORDAD,ORY,ORNMBR,NUM,ORI,ORDAD,ORNM
  1. I '$O(^ORD(101.41,"AD",+ORX,0)) W !,$P(ORX,U,2)_" has no menu items." Q
  1. W @IOF,"Menu items of "_$P(ORX,U,2),!?4,"Name",?69,"Type",!,$$REPEAT^XLFSTR("-",79)
  1. S (I,ORDAD)=0 F S I=$O(^ORD(101.41,"AD",+ORX,I)) Q:I'>0 D
  1. . S J=0 F S J=$O(^ORD(101.41,"AD",+ORX,I,J)) Q:J'>0 D
  1. . . S ORDAD=ORDAD+1,ORDAD(ORDAD)=I_U_J
  1. . . W !,ORDAD,?4,$P(^ORD(101.41,I,0),U),?69,$$TYPE($P(^(0),U,4))
  1. W !,$$REPEAT^XLFSTR("-",79)
  1. S ORY=$$REPLWITH(ORX) Q:ORY="^"
  1. D SELECT(ORY,ORDAD,.ORNMBR) Q:ORNMBR="^"
  1. Q:'$$OK W !!,$S(ORY="@":"Removing",1:"Replacing "_$P(ORX,U,2)_" with "_$P(ORY,U,2))_" in:"
  1. S CNT="" F S CNT=$O(ORNMBR(CNT)) Q:CNT="" D
  1. . D LOOP($G(ORNMBR(CNT)))
  1. Q
  1. LOOP(ORNMBR) ;
  1. F ORI=1:1:$L(ORNMBR,",") S NUM=$P(ORNMBR,",",ORI) I NUM D
  1. . S DA(1)=+ORDAD(NUM),DA=$P(ORDAD(NUM),U,2),DIE="^ORD(101.41,"_DA(1)_",10,"
  1. . S ORDAD=DA(1),ORNM=$P(^ORD(101.41,ORDAD,0),U) W !?3,ORNM_" ..."
  1. . I '$$VALID(ORY,ORDAD,.ORERR) D Q
  1. . . W "not "_$S(ORY="@":"removed.",1:"changed."),!?3,">> "_$G(ORERR)
  1. . . S I=0 F S I=$O(ORERR(I)) Q:I'>0 W !?25,"=>"_ORERR(I)
  1. . I ORY="@" S DIK=DIE D ^DIK W "done." Q
  1. . 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.")
  1. Q
  1. ;
  1. TYPE(X) ; -- Returns name of dialog type
  1. 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:"")
  1. Q Y
  1. ;
  1. DIC() ; -- ^DIC on Order Dialog file
  1. N X,Y,DIC
  1. S DIC=101.41,DIC(0)="AEQM",DIC("A")="Search for: "
  1. S DIC("?")="Enter the name of the dialog component you wish to search for."
  1. D ^DIC
  1. Q Y
  1. ;
  1. SELECT(ORY,MAX,Y) ; -- Select which Dlgs to replace items
  1. N X,DIR
  1. S DIR(0)="LA^1:"_MAX,DIR("A")=$S(ORY="@":"Remove in: ",1:"Replace in: "),DIR("B")=$S(MAX>1:"1-"_MAX,1:"1")
  1. ; S DIR("?")
  1. D ^DIR S:$D(DTOUT)!(X["^") Y="^"
  1. Q
  1. ;
  1. OK() ; -- Are you ready?
  1. N X,Y,DIR
  1. S DIR(0)="YA",DIR("A")="Are you ready? ",DIR("B")="NO"
  1. W ! D ^DIR
  1. Q +Y
  1. ;
  1. REPLWITH(ORIT) ; -- Remove item, or select replacement
  1. N X,Y,DIR,DIC
  1. S DIR(0)="FAO^1:63",DIR("A")="Replace "_$P(ORIT,U,2)_" with: "
  1. 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>."
  1. R1 D ^DIR I X="@" Q "@"
  1. I $D(DTOUT)!("^"[X) Q "^"
  1. S DIC=101.41,DIC(0)="EQM" D ^DIC I Y'>0 G R1
  1. Q Y
  1. ;
  1. VALID(ITM,DAD,ERR) ; -- Ck if ITM may be placed on DAD
  1. N DTYPE,ITYPE,Y S Y=0
  1. 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
  1. I ITM="@" S Y=1 G VQ ; ok to delete
  1. S ITYPE=$P(^ORD(101.41,+ITM,0),U,4)
  1. I ITYPE="P",DTYPE'="D" S ERR="A prompt may not be added to a "_$$TYPE(DTYPE)_"." G VQ
  1. I ITYPE="A","DOM"'[DTYPE S ERR="An action may not be added to a "_$$TYPE(DTYPE)_"." G VQ
  1. I "DQOM"[ITYPE,"OM"'[DTYPE S ERR="A "_$$TYPE(ITYPE)_" may not be added to a "_$$TYPE(DTYPE)_"." G VQ
  1. D RECURSV(+ITM,DAD,.ERR) I $D(ERR) S Y=0 G VQ
  1. S Y=1 ; ok
  1. VQ Q Y
  1. ;
  1. RECURSV(ITEM,MENU,MSG) ; -- Return 1 or 0, if recursive reference to ITEM
  1. N STACK,CNT S STACK=0,CNT=0
  1. K MSG
  1. I ITEM=MENU S MSG="Recursive Reference: "_$P($G(^ORD(101.41,ITEM,0)),U) Q ;p375 prevents menu on itself
  1. D CHKPAR(MENU)
  1. Q
  1. CHKPAR(MENU) ; follow tree to check parents
  1. N PMENU,I
  1. S STACK=STACK+1,STACK(STACK)=MENU,STACK("B",MENU)=STACK,PMENU=0
  1. F S PMENU=$O(^ORD(101.41,"AD",MENU,PMENU)) Q:'PMENU D Q:$D(MSG)
  1. . I PMENU=ITEM D Q
  1. . . S MSG="Recursive Reference: "_$P(^ORD(101.41,ITEM,0),U)
  1. . . F I=STACK:-1:1 S CNT=CNT+1,MSG(CNT)=$P(^ORD(101.41,STACK(I),0),U)
  1. . I $D(STACK("B",PMENU)) Q
  1. . D CHKPAR(PMENU)
  1. K STACK(STACK) S STACK=STACK-1
  1. Q
  1. ;
  1. INUSE(MENU) ; -- Returns 1 or 0, if MENU is in use by parameter
  1. N PARAM,ENT,Y
  1. S PARAM=$O(^XTV(8989.51,"B","OR ADD ORDERS MENU",0)),Y=0
  1. S ENT="" F S ENT=$O(^XTV(8989.5,"AC",PARAM,ENT)) Q:ENT="" I $G(^(ENT,1))=MENU S Y=1 Q
  1. Q Y
  1. ;
  1. ASSIGN ; -- Assign menu to user(s)
  1. D FULL^VALM1
  1. D EDITPAR^XPAREDIT("OR ADD ORDERS MENU")
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. INQ ; -- Inquire to Order Dialog file
  1. N X,Y,DIC,DA,DR,DIQ
  1. S DIC="^ORD(101.41,",DIC(0)="AEQM"
  1. F D ^DIC Q:Y'>0 S DA=+Y W ! D EN^DIQ W !
  1. Q
  1. ;
  1. OUTPUT(ORY) ; -- Output Xform for Value field of Response multiple
  1. N ORDIALOG,ORP,ORZ S ORZ=ORY
  1. S ORP=$P($G(^ORD(101.41,D0,6,D1,0)),U,2)
  1. 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)
  1. Q ORZ
  1. ;
  1. AOPAR ; -- List of add order menus assigned to users
  1. N BY,DHD,DIC,FLDS,FR,TO
  1. S DIC=8989.5
  1. S FR="OR ADD ORDERS MENU,?",TO="OR ADD ORDERS MENU,?"
  1. S BY="@.02,@1;S2;""Add order menu: """
  1. S DHD="CPRS Add order menu list"
  1. S FLDS="VALUE;N;""Menu"",ENTITY;""User/Location/etc."";C40"
  1. D EN1^DIP
  1. Q
  1. ;
  1. DISABLE ; -- Disable order dialogs
  1. N X,Y,DIC,DIR,ORDIS,ORI K ^TMP("ORDISABLE",$J)
  1. S DIC=101.41,DIC(0)="AEQM",DIC("A")="Select ORDER DIALOG: ",DIC("?")="Enter the name of an order dialog you wish to disable."
  1. S DIC("W")="I $L($P(^(0),U,3)) W !?3,"">> disabled: ""_$P(^(0),U,3)"
  1. F D ^DIC Q:Y'>0 S ^TMP("ORDISABLE",$J,+Y)="" S DIC("A")="ANOTHER ONE: "
  1. Q:'$O(^TMP("ORDISABLE",$J,0)) ;none selected
  1. W !!,"Enter a message to disable the dialog(s), or @ to enable again."
  1. S DIR(0)="FAO^1:40",DIR("A")="MESSAGE: "
  1. 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."
  1. D ^DIR G:$D(DTOUT)!$D(DUOUT)!(X="") DQ S ORDIS=X
  1. I '$$OK W !,"Nothing "_$S(ORDIS="@":"en",1:"dis")_"abled." H 1 G DQ
  1. 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 "."
  1. W !,"done." H 1
  1. DQ K ^TMP("ORDISABLE",$J)
  1. Q