| 1 | DVBCLURN ;ALB ISC/GTS - PRINT ROUTINE FOR MTLU LIST SEARCHES ;
|
|---|
| 2 | ;;2.7;AMIE;;Apr 10, 1995
|
|---|
| 3 | ;** ^TMP AND XTLKH ARE PASSED IN AND SHOULD NOT BE KILLED
|
|---|
| 4 | ;
|
|---|
| 5 | ;** VARIABLE DESCRIPTIONS
|
|---|
| 6 | ;** XTLKH - Entry number
|
|---|
| 7 | ;** ^TMP Global - Sort array of entries found in file ^DIC(31,
|
|---|
| 8 | ;** DVBAREF - Diagnostic code
|
|---|
| 9 | ;** DVBAREF0 - Zero node of current entry in ^DIC(31,
|
|---|
| 10 | ;** DVBAREF1 - One node of current entry in ^DIC(31,
|
|---|
| 11 | ;** DVBATEST - Node in TMP array following one printed
|
|---|
| 12 | ;
|
|---|
| 13 | WLINE ;** DISPLAY CODE AND TEXT FOR DIAGNOSIS
|
|---|
| 14 | S DVBAREF0="^DIC(31,"_Y_",0)"
|
|---|
| 15 | S DVBAREF1="^DIC(31,"_Y_",1)"
|
|---|
| 16 | I '$D(@(DVBAREF0))!('$D(@(DVBAREF1))) DO
|
|---|
| 17 | .W:XTLKH !,$J(XTLKH,4),": Bad 'ADVB' X-REF ("_Y_") on File 31...Notify IRM "
|
|---|
| 18 | Q:'$D(@(DVBAREF0))!('$D(@(DVBAREF1))) ;** QUIT if a bad pointer exists
|
|---|
| 19 | S DVBAREF=$P(@(DVBAREF0),"^",3) ;** Indirection to 0 node, file 31
|
|---|
| 20 | W:((XTLKH>1)&(XTLKH#5=1)) !!
|
|---|
| 21 | W:XTLKH !,$J(XTLKH,4),": " ;** Write Entry number
|
|---|
| 22 | ;**
|
|---|
| 23 | ;** Write Detailed Desc. if exists, else write General Desc.
|
|---|
| 24 | ;** Use indirection to the 0 and 1 nodes, file 31 (DVBAREF0, DVBAREF1)
|
|---|
| 25 | ;**
|
|---|
| 26 | W $S($D(@(DVBAREF1)):@(DVBAREF1),1:$P(@(DVBAREF0),"^",1))
|
|---|
| 27 | W " ("_DVBAREF_")"
|
|---|
| 28 | I XTLKH#5'>0 DO ;** Output number remaining, if any
|
|---|
| 29 | .S DVBATEST=$O(^TMP("XTLKHITS",$J,XTLKH))
|
|---|
| 30 | .I +DVBATEST>0 DO
|
|---|
| 31 | ..W !!,"Selections "
|
|---|
| 32 | ..W XTLKH+1
|
|---|
| 33 | ..W " through "_^TMP("XTLKHITS",$J)_" follow."
|
|---|
| 34 | K DVBATEST,DVBAREF,DVBAREF0,DVBAREF1
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | ORPHAN ;the display for the orphan MTLU look up
|
|---|
| 38 | W:XTLKMULT !,$J(XTLKH,4),": "
|
|---|
| 39 | W $P(@(XTLKREF0),"^",1)
|
|---|
| 40 | Q
|
|---|
