DVBCLURN.m

DVBCLURN ;ALB ISC/GTS - PRINT ROUTINE FOR MTLU LIST SEARCHES ;

 ;;2.7;AMIE;;Apr 10, 1995

 ;** ^TMP AND XTLKH ARE PASSED IN AND SHOULD NOT BE KILLED

 ;

 ;**  VARIABLE DESCRIPTIONS

 ;** XTLKH           - Entry number

 ;** ^TMP Global     - Sort array of entries found in file ^DIC(31,

 ;** DVBAREF         - Diagnostic code

 ;** DVBAREF0        - Zero node of current entry in ^DIC(31,

 ;** DVBAREF1        - One node of current entry in ^DIC(31,

 ;** DVBATEST        - Node in TMP array following one printed

 ;

WLINE ;** DISPLAY CODE AND TEXT FOR DIAGNOSIS

 S DVBAREF0="^DIC(31,"_Y_",0)"

 S DVBAREF1="^DIC(31,"_Y_",1)"

 I '$D(@(DVBAREF0))!('$D(@(DVBAREF1))) DO

 .W:XTLKH !,$J(XTLKH,4),": Bad 'ADVB' X-REF ("_Y_") on File 31...Notify IRM "

 Q:'$D(@(DVBAREF0))!('$D(@(DVBAREF1)))  ;** QUIT if a bad pointer exists

 S DVBAREF=$P(@(DVBAREF0),"^",3) ;** Indirection to 0 node, file 31

 W:((XTLKH>1)&(XTLKH#5=1)) !!

 W:XTLKH !,$J(XTLKH,4),": " ;** Write Entry number

 ;**

 ;** Write Detailed Desc. if exists, else write General Desc.

 ;** Use indirection to the 0 and 1 nodes, file 31 (DVBAREF0, DVBAREF1)

 ;**

 W $S($D(@(DVBAREF1)):@(DVBAREF1),1:$P(@(DVBAREF0),"^",1))

 W "  ("_DVBAREF_")"

 I XTLKH#5'>0 DO  ;** Output number remaining, if any

 .S DVBATEST=$O(^TMP("XTLKHITS",$J,XTLKH))

 .I +DVBATEST>0 DO

 ..W !!,"Selections "

 ..W XTLKH+1

 ..W " through "_^TMP("XTLKHITS",$J)_" follow."

 K DVBATEST,DVBAREF,DVBAREF0,DVBAREF1

 Q

 ;

ORPHAN ;the display for the orphan MTLU look up

 W:XTLKMULT !,$J(XTLKH,4),": "

 W $P(@(XTLKREF0),"^",1)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DVBCLURN   1575     printed  Apr 09, 2024@20:52:25                                                                                                                                                                                                    Page 2

DVBCLURN  ;ALB ISC/GTS - PRINT ROUTINE FOR MTLU LIST SEARCHES ;

 +1       ;;2.7;AMIE;;Apr 10, 1995

 +2       ;** ^TMP AND XTLKH ARE PASSED IN AND SHOULD NOT BE KILLED

 +3       ;

 +4       ;**  VARIABLE DESCRIPTIONS

 +5       ;** XTLKH           - Entry number

 +6       ;** ^TMP Global     - Sort array of entries found in file ^DIC(31,

 +7       ;** DVBAREF         - Diagnostic code

 +8       ;** DVBAREF0        - Zero node of current entry in ^DIC(31,

 +9       ;** DVBAREF1        - One node of current entry in ^DIC(31,

 +10      ;** DVBATEST        - Node in TMP array following one printed

 +11      ;

WLINE     ;** DISPLAY CODE AND TEXT FOR DIAGNOSIS

 +1        SET DVBAREF0="^DIC(31,"_Y_",0)"

 +2        SET DVBAREF1="^DIC(31,"_Y_",1)"

 +3        IF '$DATA(@(DVBAREF0))!('$DATA(@(DVBAREF1)))

               Begin DoDot:1

 +4                if XTLKH

                       WRITE !,$JUSTIFY(XTLKH,4),": Bad 'ADVB' X-REF ("_Y_") on File 31...Notify IRM "

               End DoDot:1

 +5       ;** QUIT if a bad pointer exists

           if '$DATA(@(DVBAREF0))!('$DATA(@(DVBAREF1)))

               QUIT 

 +6       ;** Indirection to 0 node, file 31

           SET DVBAREF=$PIECE(@(DVBAREF0),"^",3)

 +7        if ((XTLKH>1)&(XTLKH#5=1))

               WRITE !!

 +8       ;** Write Entry number

           if XTLKH

               WRITE !,$JUSTIFY(XTLKH,4),": "

 +9       ;**

 +10      ;** Write Detailed Desc. if exists, else write General Desc.

 +11      ;** Use indirection to the 0 and 1 nodes, file 31 (DVBAREF0, DVBAREF1)

 +12      ;**

 +13       WRITE $SELECT($DATA(@(DVBAREF1)):@(DVBAREF1),1:$PIECE(@(DVBAREF0),"^",1))

 +14       WRITE "  ("_DVBAREF_")"

 +15      ;** Output number remaining, if any

           IF XTLKH#5'>0

               Begin DoDot:1

 +16               SET DVBATEST=$ORDER(^TMP("XTLKHITS",$JOB,XTLKH))

 +17               IF +DVBATEST>0

                       Begin DoDot:2

 +18                       WRITE !!,"Selections "

 +19                       WRITE XTLKH+1

 +20                       WRITE " through "_^TMP("XTLKHITS",$JOB)_" follow."

                       End DoDot:2

               End DoDot:1

 +21       KILL DVBATEST,DVBAREF,DVBAREF0,DVBAREF1

 +22       QUIT 

 +23      ;

ORPHAN    ;the display for the orphan MTLU look up

 +1        if XTLKMULT

               WRITE !,$JUSTIFY(XTLKH,4),": "

 +2        WRITE $PIECE(@(XTLKREF0),"^",1)

 +3        QUIT