source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/A4A7B1.m@ 1800

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

initial load of WorldVistAEHR

File size: 3.2 KB
RevLine 
[613]1A4A7B1 ;CFB/SF/TUSC;NEW PERSON 3/6/16/20 LOCATOR PRINT ;4/11/96 11:46
2 ;;1.01;NEW PERSON;**9**;2/9/96
3DEVICE W !!,"This report could take some time, remember to QUEUE the report.",! K IOP,%ZIS S %ZIS="QM" D ^%ZIS K %ZIS I POP W !,"Print terminated. No device specified." G END
4 I '$D(IO("Q")) U IO G START
5 S ZTRTN="START^A4A7B1",ZTDESC="PRINT 3/6/16/20",ZTPRI=1,ZTSAVE("*")="" K IO("Q") D ^%ZTLOAD,HOME^%ZIS G END
6START ;
7 S A4A7B("TYPE","OUTP")="OUTPUT TRANSFORM",A4A7B("TYPE","EXEH")="EXECUTABLE HELP",A4A7B("TYPE","UINP")="USER INPUT",A4A7B("TYPE","AUD")="AUDIT",A4A7B("TYPE","DEL")="DELETE",A4A7B("TYPE","LAYGO")="LAYGO",A4A7B("TYPE","CR")="CROSS REFERENCE"
8 S A4A7B("TYPE","SCR")="SCREEN",A4A7B("TYPE","C")="COMPUTED",A4A7B("TYPE","V")="VARIABLE POINTER"
9 S A4A7B("TYPE","PTR")="REGULAR POINTER",A4A7B("TYPE","INP")="INPUT TRANSFORM",A4A7B("TYPE","^DIE(")="INPUT TEMPLATE",A4A7B("TYPE","^DIBT(")="SORT TEMPLATE"
10 S A4A7B("TYPE","^DIPT(")="PRINT TEMPLATE",A4A7B("TYPE","ROU")="ROUTINE",A4A7B("TYPE","^DIST(.403,")="FORM",A4A7B("TYPE","^DIST(.404,")="BLOCK"
11 S A4A7B("TYPE","^DIST(.44,")="FOREIGN FORMAT",A4A7B("TYPE","ID")="FILE IDENTIFIER",A4A7B("TYPE","ACT")="FILE ACTION",A4A7B("TYPE","M")="MISCELANEOUS"
12 S A4A7B("ID")="" F S A4A7B("ID")=$O(^UTILITY("A4A7B","XQ82",A4A7B("ID"))) Q:A4A7B("ID")="" D
13 .S A4A7B("ITEM")=""
14 .F S A4A7B("ITEM")=$O(^UTILITY("A4A7B","XQ82",A4A7B("ID"),A4A7B("ITEM"))) Q:A4A7B("ITEM")="" D
15 ..S A4A7B("LOST")="" F S A4A7B("LOST")=$O(^UTILITY("A4A7B","XQ82",A4A7B("ID"),A4A7B("ITEM"),A4A7B("LOST"))) Q:A4A7B("LOST")="" D
16 ...S A4A7B("TYPE")="" F S A4A7B("TYPE")=$O(^UTILITY("A4A7B","XQ82",A4A7B("ID"),A4A7B("ITEM"),A4A7B("LOST"),A4A7B("TYPE"))) Q:A4A7B("TYPE")="" S A4A7B("DATA")=$G(^(A4A7B("TYPE"))) D 1,HDRID,UPPTR D
17BODY ....;
18 ....W !! I (IOSL-$Y)<10 W @IOF
19 ....F A4A7B=1:1:4 I A4A7B("HDR",A4A7B)'="" W A4A7B("HDR",A4A7B),!
20 ....F A4A7B=0:1 Q:$E(A4A7B("DATA"),1+(A4A7B*(IOM-5)),(IOM-5)+(A4A7B*(IOM-5)))="" W $E(A4A7B("DATA"),1+(A4A7B*(IOM-5)),(IOM-5)+(A4A7B*(IOM-5))),!
21END K A4A7B D ^%ZISC Q
221 S A4A7B("HDR",1)="POINTER TO FILE "_A4A7B("LOST")
232 S A4A7B("HDR",2)="IS FOUND IN "_$S($D(A4A7B("TYPE",A4A7B("TYPE"))):A4A7B("TYPE",A4A7B("TYPE")),1:A4A7B("TYPE",$P(A4A7B("TYPE"),"*",1))) Q
24HDRID ;
25 S (A4A7B("HDR",3),A4A7B("HDR",4))=""
26 I A4A7B("TYPE")="WHSCR"!(A4A7B("TYPE")="WHACT") S A4A7B("HDR",3)=$S(A4A7B("ID")="WHSCR":"WHOLE FILE SCREEN",1:"WHOLE FILE ACTION")-" "_A4A7B("ID")_" FILE "_A4A7B("ID") Q
27 I $E(A4A7B("TYPE"),1,2)="CR" S A4A7B("HDR",3)="CROSS REFERENCE "_$P(A4A7B("TYPE"),"^",3)_" FILE "_A4A7B("ID")_" FIELD "_A4A7B("ITEM") Q
28 I $E(A4A7B("TYPE"))="M" S A4A7B("HDR",3)="MISCELANEOUS IN FILE "_A4A7B("ID")_" FIELD "_A4A7B("ITEM")_" NODE "_$P(A4A7B("TYPE"),"*",2) Q
29 I A4A7B("TYPE")="ROU" S A4A7B("HDR",3)="ROUTINE "_A4A7B("ID")_" LINE "_A4A7B("ITEM") Q
30 I $E(A4A7B("TYPE"))["^" S A4A7B("HDR",3)=A4A7B("TYPE",A4A7B("TYPE"))_" NAMED "_A4A7B("ID")_" NODE "_A4A7B("ITEM") Q
31 S A4A7B("HDR",3)=A4A7B("TYPE",A4A7B("TYPE"))_" FILE "_A4A7B("ID")_" FIELD "_A4A7B("ITEM")
32 Q
33UPPTR ;
34 Q:'+A4A7B("ID") S A4A7B("X")=+A4A7B("ID"),A4A7B("HDR",4)=A4A7B("ID")_";"_A4A7B("ITEM")
35UP I $G(^DD(A4A7B("X"),0,"UP")) S A4A7B("Z")=^("UP"),A4A7B("Y")=$O(^DD(A4A7B("Z"),"SB",A4A7B("X"),"")),A4A7B("X")=A4A7B("Z"),A4A7B("HDR",4)=A4A7B("HDR",4)_" MULTIPLE OF "_A4A7B("X")_";"_A4A7B("Y") G UP
36 Q
Note: See TracBrowser for help on using the repository browser.