ORCDADT ;SLC/MKB-Utility functions for ADT dialogs ;9/13/02 08:31 [9/25/02 4:28pm]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**142,141**;Dec 17, 1997
;DBIA reference section
;10015- DIQ
;
ENTS(EVT) ; -- Get list of specialties from EVT (#100.5)
Q:$G(ORDIALOG(PROMPT,"LIST")) Q:'$G(EVT)
N I,CNT,IEN,X,Y S (I,CNT)=0
S IEN=$S($P($G(^ORD(100.5,+EVT,0)),U,12):+$P(^(0),U,12),1:+EVT)
F S I=$O(^ORD(100.5,IEN,"TS",I)) Q:I<1 S X=+$G(^(I,0)) D
. S Y=$$GET1^DIQ(45.7,X_",",.01)
. S CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=X_U_Y
. S ORDIALOG(PROMPT,"LIST","B",Y)=X
S:CNT ORDIALOG(PROMPT,"LIST")=CNT_"^1"
Q
;
DEFTS(EVT) ; -- Return default specialty for EVT (#100.5)
N I,Y,IEN S Y=""
;If child event then get parent event for default:
S IEN=$S($P($G(^ORD(100.5,+$G(EVT),0)),U,12):+$P(^(0),U,12),1:+$G(EVT))
S I=+$O(^ORD(100.5,IEN,"TS","DEF",1,0))
S:I Y=+$G(^ORD(100.5,IEN,"TS",I,0)) ;default selection
Q Y
;
XHELP(PTR) ; -- Xecutable help
I $D(ORDIALOG(PTR,"LIST")),X="?"!$P(ORDIALOG(PTR,"LIST"),U,2) D LIST^ORCD Q
D P^ORCDLGH ; ??-help
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCDADT 1075 printed Jan 18, 2025@03:29:05 Page 2
ORCDADT ;SLC/MKB-Utility functions for ADT dialogs ;9/13/02 08:31 [9/25/02 4:28pm]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**142,141**;Dec 17, 1997
+2 ;DBIA reference section
+3 ;10015- DIQ
+4 ;
ENTS(EVT) ; -- Get list of specialties from EVT (#100.5)
+1 if $GET(ORDIALOG(PROMPT,"LIST"))
QUIT
if '$GET(EVT)
QUIT
+2 NEW I,CNT,IEN,X,Y
SET (I,CNT)=0
+3 SET IEN=$SELECT($PIECE($GET(^ORD(100.5,+EVT,0)),U,12):+$PIECE(^(0),U,12),1:+EVT)
+4 FOR
SET I=$ORDER(^ORD(100.5,IEN,"TS",I))
if I<1
QUIT
SET X=+$GET(^(I,0))
Begin DoDot:1
+5 SET Y=$$GET1^DIQ(45.7,X_",",.01)
+6 SET CNT=CNT+1
SET ORDIALOG(PROMPT,"LIST",CNT)=X_U_Y
+7 SET ORDIALOG(PROMPT,"LIST","B",Y)=X
End DoDot:1
+8 if CNT
SET ORDIALOG(PROMPT,"LIST")=CNT_"^1"
+9 QUIT
+10 ;
DEFTS(EVT) ; -- Return default specialty for EVT (#100.5)
+1 NEW I,Y,IEN
SET Y=""
+2 ;If child event then get parent event for default:
+3 SET IEN=$SELECT($PIECE($GET(^ORD(100.5,+$GET(EVT),0)),U,12):+$PIECE(^(0),U,12),1:+$GET(EVT))
+4 SET I=+$ORDER(^ORD(100.5,IEN,"TS","DEF",1,0))
+5 ;default selection
if I
SET Y=+$GET(^ORD(100.5,IEN,"TS",I,0))
+6 QUIT Y
+7 ;
XHELP(PTR) ; -- Xecutable help
+1 IF $DATA(ORDIALOG(PTR,"LIST"))
IF X="?"!$PIECE(ORDIALOG(PTR,"LIST"),U,2)
DO LIST^ORCD
QUIT
+2 ; ??-help
DO P^ORCDLGH
+3 QUIT
