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

ORQOUTL.m

Go to the documentation of this file.
ORQOUTL ; SLC/AGP - Utility report for Order Dialogs ;05/22/2018
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**377**;DEC 17, 1997;Build 582
 ;
 ;
 ;
 Q
 ;
FINDOD(RESULT,INPUT,SUB) ;
 K ^TMP($J,SUB),^TMP($J,"DIALOGS")
 N NAME,ODIEN
 S RESULT=$NA(^TMP($J,SUB))
 S NAME="" F  S NAME=$O(INPUT(NAME)) Q:NAME=""  D
 .S ODIEN=$O(^ORD(101.41,"B",NAME,"")) Q:ODIEN=""
 .S ORREM(ODIEN_";ORD(101.41,")=""
 .S ^TMP($J,SUB,ODIEN)=NAME
 .D FINDORD(ODIEN,SUB)
 D FINDREM(SUB,.ORREM)
 Q
 ;
FINDOPAR(RESULT,IEN) ;
 N CNT,ITEM,NODE,SUB
 K ^TMP($J,"ORDER MENU ON LIST")
 S SUB="OR REM ITEMS"
 D FINDRORD(IEN,SUB)
 S CNT=0 F  S CNT=$O(^TMP($J,SUB,IEN,"ORDER MENUS",CNT)) Q:CNT'>0  D
 .S NODE=$G(^TMP($J,SUB,IEN,"ORDER MENUS",CNT))
 .S ITEM=$O(^ORD(101.41,"B",$P(NODE,U),"")) Q:IEN'>0
 .S RESULT(ITEM)=NODE
 Q
FINDQO(RESULT,INPUT,SUB,RETMENU,RETSTRCT) ;
 N CNT,DSGPAR,DSGRP,I,J,NAME,NODE,ODIEN,OIIEN,ORDIALOG,ORREM,ORTYPE,PERQOAR,ORREMD,QOIEN,TEMP,X,Y
 K ^TMP($J,SUB),^TMP($J,"DIALOGS")
 S RESULT=$NA(^TMP($J,SUB))
 ;Build a list of Display Groups that contains the default dialog defined in INPUT
 S NAME="" F  S NAME=$O(INPUT(NAME)) Q:NAME=""  D
 .S ODIEN=$O(^ORD(101.41,"AB",NAME,"")) Q:ODIEN=""
 .S DSGRP=0 F  S DSGRP=$O(^ORD(100.98,DSGRP)) Q:DSGRP'>0  D
 ..I $P(^ORD(100.98,DSGRP,0),U,4)=ODIEN S DSGPAR(DSGRP,NAME)=""
 ;
 S OIIEN=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM","")) Q:OIIEN'>0
 S QOIEN=0 F  S QOIEN=$O(^ORD(101.41,QOIEN)) Q:QOIEN'>0  D
 .I $$ISVALID(QOIEN,.DSGPAR)=0 Q
 .S NODE=$G(^ORD(101.41,QOIEN,0))
 .S ^TMP($J,SUB,QOIEN)=$P(NODE,U,1,4)
 .S ^TMP($J,SUB,QOIEN,"ISPERQO")=$S($D(^ORD(101.44,"C",QOIEN)):1,1:0)
 .S ORREM(QOIEN_";ORD(101.41,")=""
 .I $G(RETSTRCT)=0 Q
 .S ORTYPE="Z"
 .K ORDIALOG
 .D GETQDLG^ORCD(QOIEN)
 .M ^TMP($J,SUB,QOIEN,"ORDIALOG")=ORDIALOG
 ;
 I RETMENU=0 G FINDQOX
 ;find menu structure order dialog exists on
 S QOIEN=0 F  S QOIEN=$O(^TMP($J,SUB,QOIEN)) Q:QOIEN'>0  D
 .D FINDORD(QOIEN,SUB)
 ;find reminder dialogs order dialog exisits on
 D FINDREM(SUB,.ORREM)
FINDQOX ;
 K ^TMP($J,"DIALOGS")
 Q
 ;
FINDORD(QOIEN,SUB) ;
 N CNT,IEN,LIST,NODE,TIEN,TOP
 S IEN=0,CNT=0 F  S IEN=$O(^ORD(101.41,"AD",QOIEN,IEN)) Q:IEN'>0  D
 .S NODE=$G(^ORD(101.41,IEN,0)) I NODE="" Q
 .S $P(NODE,U,4)=$$GETTYPE($P(NODE,U,4))
 .S CNT=CNT+1,^TMP($J,SUB,QOIEN,"ORDER MENUS",CNT)=NODE
 Q
 ;
FINDRORD(QOIEN,SUB) ;
 N CNT,IEN,LIST,NODE,TIEN,TOP
 S CNT=+$O(^TMP($J,SUB,QOIEN,"ORDER MENUS",""),-1)
 S IEN=0 F  S IEN=$O(^ORD(101.41,"AD",QOIEN,IEN)) Q:IEN'>0  D
 .I $D(^TMP($J,"ORDER MENU ON LIST",IEN)) Q
 .S NODE=$G(^ORD(101.41,IEN,0)) I NODE="" Q
 .S $P(NODE,U,4)=$$GETTYPE($P(NODE,U,4))
 .S CNT=CNT+1,^TMP($J,SUB,QOIEN,"ORDER MENUS",CNT)=NODE
 .S ^TMP($J,"ORDER MENU ON LIST",IEN)=""
 .D FINDRORD(IEN,SUB)
 Q
 ;
FINDREM(SUB,ORREM) ;
 N I,IEN
 D APIALL^PXRMDLR3("DIALOGS",.ORREM,0)
 S I="" F  S I=$O(^TMP($J,"DIALOGS",I)) Q:I=""  D
 .S IEN=+I
 .I $D(^TMP($J,SUB,I,"ERROR")) S ^TMP($J,SUB,IEN,"REMINDER DIALOG",1)="ERROR: Could Process Reminder List" Q
 .I '$D(^TMP($J,SUB,IEN)) Q
 .M ^TMP($J,SUB,IEN,"REMINDER DIALOGS")=^TMP($J,"DIALOGS",I)
 Q
 ;
GETTYPE(TYPE) ;
 N RESULT S RESULT=$S(TYPE="Q":"Quick Order",TYPE="M":"Menu",TYPE="D":"Dialog",TYPE="O":"Order Set",TYPE="A":"Action",1:"")
 Q RESULT
 ;
ISVALID(IEN,DSGPAR) ;
 N NODE,QODSG
 S NODE=$G(^ORD(101.41,IEN,0))
 ;Quit if not a quick order
 I $P(NODE,U,4)'="Q" Q 0
 ;Disregard order dialog entry does not contain a valid display group
 S QODSG=$P(NODE,U,5) I QODSG="" Q 0
 I '$D(DSGPAR(QODSG)) Q 0
 Q 1
 ;