- 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 ---[H[J[2J[HDVBCLURN 1575 printed Apr 23, 2025@17:59:16 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
