ORWTPUP.m

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 ---ORWTPUP   584     printed  Apr 09, 2024@21:42:19                                                                                                                                                                                                      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