Routine: A4A7B1

A4A7B1 ;CFB/SF/TUSC;NEW PERSON 3/6/16/20 LOCATOR PRINT ;4/11/96  11:46

 ;;1.01;NEW PERSON;**9**;2/9/96

DEVICE 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

 I '$D(IO("Q")) U IO G START

 S ZTRTN="START^A4A7B1",ZTDESC="PRINT 3/6/16/20",ZTPRI=1,ZTSAVE("*")="" K IO("Q") D ^%ZTLOAD,HOME^%ZIS G END

START ;

 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"

 S A4A7B("TYPE","SCR")="SCREEN",A4A7B("TYPE","C")="COMPUTED",A4A7B("TYPE","V")="VARIABLE POINTER"

 S A4A7B("TYPE","PTR")="REGULAR POINTER",A4A7B("TYPE","INP")="INPUT TRANSFORM",A4A7B("TYPE","^DIE(")="INPUT TEMPLATE",A4A7B("TYPE","^DIBT(")="SORT TEMPLATE"

 S A4A7B("TYPE","^DIPT(")="PRINT TEMPLATE",A4A7B("TYPE","ROU")="ROUTINE",A4A7B("TYPE","^DIST(.403,")="FORM",A4A7B("TYPE","^DIST(.404,")="BLOCK"

 S A4A7B("TYPE","^DIST(.44,")="FOREIGN FORMAT",A4A7B("TYPE","ID")="FILE IDENTIFIER",A4A7B("TYPE","ACT")="FILE ACTION",A4A7B("TYPE","M")="MISCELANEOUS"

 S A4A7B("ID")="" F  S A4A7B("ID")=$O(^UTILITY("A4A7B","XQ82",A4A7B("ID"))) Q:A4A7B("ID")=""  D

 .S A4A7B("ITEM")=""

 .F  S A4A7B("ITEM")=$O(^UTILITY("A4A7B","XQ82",A4A7B("ID"),A4A7B("ITEM"))) Q:A4A7B("ITEM")=""  D

 ..S A4A7B("LOST")="" F  S A4A7B("LOST")=$O(^UTILITY("A4A7B","XQ82",A4A7B("ID"),A4A7B("ITEM"),A4A7B("LOST"))) Q:A4A7B("LOST")=""  D

 ...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

BODY ....;

 ....W !! I (IOSL-$Y)<10 W @IOF

 ....F A4A7B=1:1:4 I A4A7B("HDR",A4A7B)'="" W A4A7B("HDR",A4A7B),!

 ....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))),!

END K A4A7B D ^%ZISC Q

1 S A4A7B("HDR",1)="POINTER TO FILE "_A4A7B("LOST")

2 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

HDRID ;

 S (A4A7B("HDR",3),A4A7B("HDR",4))=""

 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

 I $E(A4A7B("TYPE"),1,2)="CR" S A4A7B("HDR",3)="CROSS REFERENCE "_$P(A4A7B("TYPE"),"^",3)_" FILE "_A4A7B("ID")_" FIELD "_A4A7B("ITEM") Q

 I $E(A4A7B("TYPE"))="M" S A4A7B("HDR",3)="MISCELANEOUS IN FILE "_A4A7B("ID")_" FIELD "_A4A7B("ITEM")_" NODE "_$P(A4A7B("TYPE"),"*",2) Q

 I A4A7B("TYPE")="ROU" S A4A7B("HDR",3)="ROUTINE "_A4A7B("ID")_" LINE "_A4A7B("ITEM") Q

 I $E(A4A7B("TYPE"))["^" S A4A7B("HDR",3)=A4A7B("TYPE",A4A7B("TYPE"))_" NAMED "_A4A7B("ID")_" NODE "_A4A7B("ITEM") Q

 S A4A7B("HDR",3)=A4A7B("TYPE",A4A7B("TYPE"))_" FILE "_A4A7B("ID")_" FIELD "_A4A7B("ITEM")

UPPTR ;

 Q:'+A4A7B("ID")  S A4A7B("X")=+A4A7B("ID"),A4A7B("HDR",4)=A4A7B("ID")_";"_A4A7B("ITEM")

UP 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

A4A7B1    ;CFB/SF/TUSC;NEW PERSON 3/6/16/20 LOCATOR PRINT ;4/11/96  11:46

 +1       ;;1.01;NEW PERSON;**9**;2/9/96

DEVICE     WRITE !!,"This report could take some time, remember to QUEUE the report.",!

           KILL IOP,%ZIS

           SET %ZIS="QM"

           DO ^%ZIS

           KILL %ZIS

           IF POP

               WRITE !,"Print terminated. No device specified."

               GOTO END

 +1        IF '$DATA(IO("Q"))

               USE IO

               GOTO START

 +2        SET ZTRTN="START^A4A7B1"

           SET ZTDESC="PRINT 3/6/16/20"

           SET ZTPRI=1

           SET ZTSAVE("*")=""

           KILL IO("Q")

           DO ^%ZTLOAD

           DO HOME^%ZIS

           GOTO END

START     ;

 +1        SET A4A7B("TYPE","OUTP")="OUTPUT TRANSFORM"

           SET A4A7B("TYPE","EXEH")="EXECUTABLE HELP"

           SET A4A7B("TYPE","UINP")="USER INPUT"

           SET A4A7B("TYPE","AUD")="AUDIT"

           SET A4A7B("TYPE","DEL")="DELETE"

           SET A4A7B("TYPE","LAYGO")="LAYGO"

           SET A4A7B("TYPE","CR")="CROSS REFERENCE"

 +2        SET A4A7B("TYPE","SCR")="SCREEN"

           SET A4A7B("TYPE","C")="COMPUTED"

           SET A4A7B("TYPE","V")="VARIABLE POINTER"

 +3        SET A4A7B("TYPE","PTR")="REGULAR POINTER"

           SET A4A7B("TYPE","INP")="INPUT TRANSFORM"

           SET A4A7B("TYPE","^DIE(")="INPUT TEMPLATE"

           SET A4A7B("TYPE","^DIBT(")="SORT TEMPLATE"

 +4        SET A4A7B("TYPE","^DIPT(")="PRINT TEMPLATE"

           SET A4A7B("TYPE","ROU")="ROUTINE"

           SET A4A7B("TYPE","^DIST(.403,")="FORM"

           SET A4A7B("TYPE","^DIST(.404,")="BLOCK"

 +5        SET A4A7B("TYPE","^DIST(.44,")="FOREIGN FORMAT"

           SET A4A7B("TYPE","ID")="FILE IDENTIFIER"

           SET A4A7B("TYPE","ACT")="FILE ACTION"

           SET A4A7B("TYPE","M")="MISCELANEOUS"

 +6        SET A4A7B("ID")=""

FOR

               SET A4A7B("ID")=$ORDER(^UTILITY("A4A7B","XQ82",A4A7B("ID")))

               IF A4A7B("ID")=""

                   QUIT

               Begin DoDot:1

 +7                SET A4A7B("ITEM")=""

 +8                FOR

                       SET A4A7B("ITEM")=$ORDER(^UTILITY("A4A7B","XQ82",A4A7B("ID"),A4A7B("ITEM")))

                       IF A4A7B("ITEM")=""

                           QUIT

                       Begin DoDot:2

 +9                        SET A4A7B("LOST")=""

FOR

                               SET A4A7B("LOST")=$ORDER(^UTILITY("A4A7B","XQ82",A4A7B("ID"),A4A7B("ITEM"),A4A7B("LOST")))

                               IF A4A7B("LOST")=""

                                   QUIT

                               Begin DoDot:3

 +10                               SET A4A7B("TYPE")=""

FOR

                                       SET A4A7B("TYPE")=$ORDER(^UTILITY("A4A7B","XQ82",A4A7B("ID"),A4A7B("ITEM"),A4A7B("LOST"),A4A7B("TYPE")))

                                       IF A4A7B("TYPE")=""

                                           QUIT

                                       SET A4A7B("DATA")=$GET(^(A4A7B("TYPE")))

                                       DO 1

                                       DO HDRID

                                       DO UPPTR

                                       Begin DoDot:4

BODY      ;

 +1                                        WRITE !!

                                           IF (IOSL-$Y)<10

                                               WRITE @IOF

 +2                                        FOR A4A7B=1:1:4

                                               IF A4A7B("HDR",A4A7B)'=""

                                                   WRITE A4A7B("HDR",A4A7B),!

 +3                                        FOR A4A7B=0:1

                                               IF $EXTRACT(A4A7B("DATA"),1+(A4A7B*(IOM-5)),(IOM-5)+(A4A7B*(IOM-5)))=""

                                                   QUIT

                                               WRITE $EXTRACT(A4A7B("DATA"),1+(A4A7B*(IOM-5)),(IOM-5)+(A4A7B*(IOM-5))),!

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

END        KILL A4A7B

           DO ^%ZISC

           QUIT

1          SET A4A7B("HDR",1)="POINTER TO FILE "_A4A7B("LOST")

2          SET A4A7B("HDR",2)="IS FOUND IN "_$SELECT($DATA(A4A7B("TYPE",A4A7B("TYPE"))):A4A7B("TYPE",A4A7B("TYPE")),1:A4A7B("TYPE",$PIECE(A4A7B("TYPE"),"*",1)))

           QUIT

HDRID     ;

 +1        SET (A4A7B("HDR",3),A4A7B("HDR",4))=""

 +2        IF A4A7B("TYPE")="WHSCR"!(A4A7B("TYPE")="WHACT")

               SET A4A7B("HDR",3)=$SELECT(A4A7B("ID")="WHSCR":"WHOLE FILE SCREEN",1:"WHOLE FILE ACTION")-" "_A4A7B("ID")_" FILE "_A4A7B("ID")

               QUIT

 +3        IF $EXTRACT(A4A7B("TYPE"),1,2)="CR"

               SET A4A7B("HDR",3)="CROSS REFERENCE "_$PIECE(A4A7B("TYPE"),"^",3)_" FILE "_A4A7B("ID")_" FIELD "_A4A7B("ITEM")

               QUIT

 +4        IF $EXTRACT(A4A7B("TYPE"))="M"

               SET A4A7B("HDR",3)="MISCELANEOUS IN FILE "_A4A7B("ID")_" FIELD "_A4A7B("ITEM")_" NODE "_$PIECE(A4A7B("TYPE"),"*",2)

               QUIT

 +5        IF A4A7B("TYPE")="ROU"

               SET A4A7B("HDR",3)="ROUTINE "_A4A7B("ID")_" LINE "_A4A7B("ITEM")

               QUIT

 +6        IF $EXTRACT(A4A7B("TYPE"))["^"

               SET A4A7B("HDR",3)=A4A7B("TYPE",A4A7B("TYPE"))_" NAMED "_A4A7B("ID")_" NODE "_A4A7B("ITEM")

               QUIT

 +7        SET A4A7B("HDR",3)=A4A7B("TYPE",A4A7B("TYPE"))_" FILE "_A4A7B("ID")_" FIELD "_A4A7B("ITEM")

 +8        QUIT

UPPTR     ;

 +1        IF '+A4A7B("ID")

               QUIT

           SET A4A7B("X")=+A4A7B("ID")

           SET A4A7B("HDR",4)=A4A7B("ID")_";"_A4A7B("ITEM")

UP         IF $GET(^DD(A4A7B("X"),0,"UP"))

               SET A4A7B("Z")=^("UP")

               SET A4A7B("Y")=$ORDER(^DD(A4A7B("Z"),"SB",A4A7B("X"),""))

               SET A4A7B("X")=A4A7B("Z")

               SET A4A7B("HDR",4)=A4A7B("HDR",4)_" MULTIPLE OF "_A4A7B("X")_";"_A4A7B("Y")

               GOTO UP

 +1        QUIT

A4A7B1.m