QAMUTL2.m

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 ---QAMUTL2   1392     printed  Mar 13, 2025@20:47:25                                                                                                                                                                                                     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