source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCLURN.m@ 1651

Last change on this file since 1651 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1DVBCLURN ;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 ;
13WLINE ;** 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 ;
37ORPHAN ;the display for the orphan MTLU look up
38 W:XTLKMULT !,$J(XTLKH,4),": "
39 W $P(@(XTLKREF0),"^",1)
40 Q
Note: See TracBrowser for help on using the repository browser.