QAMUTL2 ;HISC/DAD-MONITORING TOOL UTILITIES ;2/10/92 07:33
;;1.0;Clinical Monitoring System;;09/13/1993
EN1 ; *** RETURN DIR STRINGS FOR A DATA ELEMENT
; REQUIRES: QAMELEM = DATA ELEMENT INTERNAL ENTRY NUMBER
; RETURNS: ALL NON-NULL DIR INPUT VARIABLES/ARRAYS
; QADIRPNT = CODE TO CREATE DATA POINTERS
; QADIROUT = DIR OUTPUT TRANSFORM
K DIR,QADIROUT,QADIRPNT
Q:$S($D(QAMELEM)[0:1,QAMELEM'>0:1,$D(^QA(743.4,QAMELEM,0))[0:1,1:0)
N QA,QAM S QAM=$S($D(^QA(743.4,QAMELEM,"DIR"))#2:^("DIR"),1:"")
S DIR(0)=$S($D(^QA(743.4,QAMELEM,"DIR0"))#2:^("DIR0"),1:"")
S DIR("A")=$S($P(QAM,"^")]"":$P(QAM,"^"),1:$P(^QA(743.4,QAMELEM,0),"^"))
S DIR("B")=$S($P(QAM,"^",2)]"":$P(QAM,"^",2),1:"")
S DIR("T")=$S($P(QAM,"^",3):$P(QAM,"^",3),1:DTIME)
S DIR("?")=$S($D(^QA(743.4,QAMELEM,"DIRQ"))#2:^("DIRQ"),1:"")
S DIR("??")=$S($D(^QA(743.4,QAMELEM,"DIRQQ"))#2:^("DIRQQ"),1:"")
S QADIROUT=$S($D(^QA(743.4,QAMELEM,"DIROUT"))#2:^("DIROUT"),1:"")
S QADIRPNT=$S($D(^QA(743.4,QAMELEM,"POINT"))#2:^("POINT"),1:"")
S QAM=1 F QA=0:0 S QA=$O(^QA(743.4,QAMELEM,"DIR1",QA)) Q:QA'>0 S DIR("?",QAM)=^QA(743.4,QAMELEM,"DIR1",QA,0),QAM=QAM+1
S QAM=1 F QA=0:0 S QA=$O(^QA(743.4,QAMELEM,"DIR2",QA)) Q:QA'>0 S DIR("A",QAM)=^QA(743.4,QAMELEM,"DIR2",QA,0),QAM=QAM+1
F QA=0,"A","B","T","?","??" K:DIR(QA)="" DIR(QA)
K:QADIROUT="" QADIROUT K:QADIRPNT="" QADIRPNT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMUTL2 1392 printed Oct 16, 2024@17:43:37 Page 2
QAMUTL2 ;HISC/DAD-MONITORING TOOL UTILITIES ;2/10/92 07:33
+1 ;;1.0;Clinical Monitoring System;;09/13/1993
EN1 ; *** RETURN DIR STRINGS FOR A DATA ELEMENT
+1 ; REQUIRES: QAMELEM = DATA ELEMENT INTERNAL ENTRY NUMBER
+2 ; RETURNS: ALL NON-NULL DIR INPUT VARIABLES/ARRAYS
+3 ; QADIRPNT = CODE TO CREATE DATA POINTERS
+4 ; QADIROUT = DIR OUTPUT TRANSFORM
+5 KILL DIR,QADIROUT,QADIRPNT
+6 if $SELECT($DATA(QAMELEM)[0
QUIT
+7 NEW QA,QAM
SET QAM=$SELECT($DATA(^QA(743.4,QAMELEM,"DIR"))#2:^("DIR"),1:"")
+8 SET DIR(0)=$SELECT($DATA(^QA(743.4,QAMELEM,"DIR0"))#2:^("DIR0"),1:"")
+9 SET DIR("A")=$SELECT($PIECE(QAM,"^")]"":$PIECE(QAM,"^"),1:$PIECE(^QA(743.4,QAMELEM,0),"^"))
+10 SET DIR("B")=$SELECT($PIECE(QAM,"^",2)]"":$PIECE(QAM,"^",2),1:"")
+11 SET DIR("T")=$SELECT($PIECE(QAM,"^",3):$PIECE(QAM,"^",3),1:DTIME)
+12 SET DIR("?")=$SELECT($DATA(^QA(743.4,QAMELEM,"DIRQ"))#2:^("DIRQ"),1:"")
+13 SET DIR("??")=$SELECT($DATA(^QA(743.4,QAMELEM,"DIRQQ"))#2:^("DIRQQ"),1:"")
+14 SET QADIROUT=$SELECT($DATA(^QA(743.4,QAMELEM,"DIROUT"))#2:^("DIROUT"),1:"")
+15 SET QADIRPNT=$SELECT($DATA(^QA(743.4,QAMELEM,"POINT"))#2:^("POINT"),1:"")
+16 SET QAM=1
FOR QA=0:0
SET QA=$ORDER(^QA(743.4,QAMELEM,"DIR1",QA))
if QA'>0
QUIT
SET DIR("?",QAM)=^QA(743.4,QAMELEM,"DIR1",QA,0)
SET QAM=QAM+1
+17 SET QAM=1
FOR QA=0:0
SET QA=$ORDER(^QA(743.4,QAMELEM,"DIR2",QA))
if QA'>0
QUIT
SET DIR("A",QAM)=^QA(743.4,QAMELEM,"DIR2",QA,0)
SET QAM=QAM+1
+18 FOR QA=0,"A","B","T","?","??"
if DIR(QA)=""
KILL DIR(QA)
+19 if QADIROUT=""
KILL QADIROUT
if QADIRPNT=""
KILL QADIRPNT
+20 QUIT
