- 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")
- Q
- 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
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HA4A7B1 3361 printed Feb 18, 2025@23:28:42 Page 2
- 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
