ORWTPUP ; SLC/STAFF Personal Preference - Utility Parameters ;5/22/00 09:59
;;3.0;ORDER ENTRY/RESULTS REPORTING;**85**;Oct 24, 2000
;
PDLKUP(NAME) ; $$(parameter definition name) -> ien
I '$L(NAME) Q 0
Q +$O(^XTV(8989.51,"B",NAME,0))
;
PDSET(PARAM,CODES) ; return set of codes from domain value of parameter
N CODE,NODE,NUM K CODES
I PARAM'=+PARAM S PARAM=$$PDLKUP(PARAM)
I 'PARAM Q
S NODE=$G(^XTV(8989.51,+PARAM,1))
I $P(NODE,U)'="S" Q
S NODE=$P(NODE,U,2)
F NUM=1:1 S CODE=$P(NODE,";",NUM) Q:'$L(CODE) D
.S CODES(NUM)=$P(CODE,":")_U_$P(CODE,":",2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWTPUP 584 printed Dec 13, 2024@02:37:40 Page 2
ORWTPUP ; SLC/STAFF Personal Preference - Utility Parameters ;5/22/00 09:59
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85**;Oct 24, 2000
+2 ;
PDLKUP(NAME) ; $$(parameter definition name) -> ien
+1 IF '$LENGTH(NAME)
QUIT 0
+2 QUIT +$ORDER(^XTV(8989.51,"B",NAME,0))
+3 ;
PDSET(PARAM,CODES) ; return set of codes from domain value of parameter
+1 NEW CODE,NODE,NUM
KILL CODES
+2 IF PARAM'=+PARAM
SET PARAM=$$PDLKUP(PARAM)
+3 IF 'PARAM
QUIT
+4 SET NODE=$GET(^XTV(8989.51,+PARAM,1))
+5 IF $PIECE(NODE,U)'="S"
QUIT
+6 SET NODE=$PIECE(NODE,U,2)
+7 FOR NUM=1:1
SET CODE=$PIECE(NODE,";",NUM)
if '$LENGTH(CODE)
QUIT
Begin DoDot:1
+8 SET CODES(NUM)=$PIECE(CODE,":")_U_$PIECE(CODE,":",2)
End DoDot:1
+9 QUIT
