A4A7B ;CFB/SF/TUSC; NEW PERSON FILE 3/6/16/20 LOCATOR ;05/28/97 14:40
;;1.01;NEW PERSON;**9,10**;2/9/96
D ^A4A7B0,PARTIAL^A4A7B0 I $D(^UTILITY("A4A7B","SECTION"))!($D(ANS)) G Q
DATADIC ;start looping though the data dictionary
S A4A7B("START")=$P(^UTILITY("A4A7B","CKPT"),"^",2),A4A7B("STOP")=$S($G(^UTILITY("A4A7B","SECTION"))'="":$P(^("SECTION"),"^",3),1:99999999999)
F A4A7B("A")=A4A7B("START"):0:A4A7B("STOP") S $P(^UTILITY("A4A7B","CKPT"),"^",2)=A4A7B("A"),A4A7B("A")=$O(^DD(A4A7B("A"))) Q:A4A7B("A")'>0 G Q:^UTILITY("A4A7B","RUN")="STOP" D
.I (A4A7B("A")\1=3!(A4A7B("A")\1=6)!(A4A7B("A")\1=16)!(A4A7B("A")\1=20)!(A4A7B("A")\1=200)) Q
.D FILE S A4A7B("B")="" F S A4A7B("B")=$O(^DD(A4A7B("A"),A4A7B("B"))) Q:A4A7B("B")="" I A4A7B("B")>0 D
..I +A4A7B("B") D
...K A4A7B(0) S A4A7B(0)=$G(^DD(A4A7B("A"),A4A7B("B"),0)) Q:A4A7B(0)="" S A4A7B(0,5)=$P(A4A7B(0),"^",5,999) F A4A7B=1:1:4 S A4A7B(0,A4A7B)=$P(A4A7B(0),"^",A4A7B)
...Q:+A4A7B(0,2)
...I A4A7B(0,2)["V" F A4A7B("C")=0:0 S A4A7B("C")=$O(^DD(A4A7B("A"),A4A7B("B"),"V","B",A4A7B("C"))) Q:A4A7B("C")'>0 S A4A7B("NAIL")="V",A4A7B("HAY")=$G(^DIC(A4A7B("C"),0,"GL")) D HORSE
...I A4A7B(0,2)'["S",A4A7B(0,3)["DIC(" S A4A7B("HAY")="^"_A4A7B(0,3),A4A7B("NAIL")="PTR" D HORSE
...I A4A7B(0,5)["^DIC(" S A4A7B("HAY")=A4A7B(0,5),A4A7B("NAIL")="INP" D HORSE
..S A4A7B("C")="" F S A4A7B("C")=$O(@A4A7B("IND",3)) Q:A4A7B("C")="" S A4A7B("D")="",A4A7B("D")=$O(@A4A7B("IND",4)) I A4A7B("C")'="0" D
...I A4A7B("D")="" S A4A7B("HAY")=@A4A7B("IND",3) D NAIL,HORSE Q
...S A4A7B("D")=$S(A4A7B("C")=1:0,1:"") F S A4A7B("D")=$O(@A4A7B("IND",4)) Q:A4A7B("D")="" S A4A7B("E")="" F S A4A7B("E")=$O(@A4A7B("IND",5)) Q:A4A7B("E")="" D
....S A4A7B("HAY")=$G(@A4A7B("IND",5)) I A4A7B("HAY")'="" S A4A7B=$G(^(0)) D NAIL I A4A7B("NAIL")="CR" S A4A7B("NAIL")=A4A7B("NAIL")_"*"_A4A7B D HORSE
Q:$D(^UTILITY("A4A7B","SECTION"))
S ^UTILITY("A4A7B","CKPT")="DIE^DIE(0)"
DIE ;
S A4A7B("DIE")="^"_$P(^UTILITY("A4A7B","CKPT"),"^",2),A4A7B("TEST")=$P(A4A7B("DIE"),"0)") F S A4A7B("DIE")=$Q(@A4A7B("DIE")) Q:^UTILITY("A4A7B","RUN")="STOP" Q:A4A7B("DIE")'[A4A7B("TEST") Q:'+$P(A4A7B("DIE"),A4A7B("TEST"),2) D
.I $P(A4A7B("DIE"),A4A7B("TEST"),2)?.N1",0)" S A4A7B("A")=$P($G(@A4A7B("DIE")),"^")
.S A4A7B("NAIL")=A4A7B("TEST") I A4A7B("DIE")["^DIST(" S A4A7B("NAIL")=$P(A4A7B("DIE"),",")
.S A4A7B("B")=$P(A4A7B("DIE"),",",2,999)
.I $D(@A4A7B("DIE")) S A4A7B("HAY")=@A4A7B("DIE") D HORSE
.I +$P(A4A7B("DIE"),"^DIE(",2)>(+$P($P(^UTILITY("A4A7B","CKPT"),"^",2),"DIE(",2)) S $P(^UTILITY("A4A7B","CKPT"),"^",2)=$P(A4A7B("DIE"),"^",2,999)
Q:$D(^UTILITY("A4A7B","SECTION"))
S X=A4A7B("TEST") I X'="^DIST(.404," S $P(^UTILITY("A4A7B","CKPT"),"^",2)=$S(X="^DIE(":"DIBT(0)",X="^DIBT(":"DIPT(0)",X="^DIPT(":"DD(""FUNC"",0)",X="^DD((""FUNC"",":"DIST(.403,0)",1:"DIST(.404,0)") G DIE
K A4A7B("DIE"),A4A7B("TEST")
S ^UTILITY("A4A7B","CKPT")="ROU^2" K ^UTILITY("A4A7B0")
ROU S A4A7B("STRING")="^A^B^C^D^E^F^G^H^I^J^K^L^M^N^O^P^Q^R^S^T^U^V^W^X^Y^Z^ZZZZZ"
S A4A7B("FIND")="F S A4A7B(""FIRST"")=$O(^$R(A4A7B(""FIRST""))) Q:A4A7B(""FIRST"")="""" Q:A4A7B(""FIRST"")]A4A7B(""LAST"") S ^UTILITY(""A4A7B0"",A4A7B(""FIRST""))="""""
S A4A7B("LINE")="S X="""" F S X=$O(^UTILITY(""A4A7B0"",X)) Q:X="""" F Y=0:1 ZL @X Q:$T(@X+Y)="""" S A4A7B(""NAIL"")=""ROU"",A4A7B(""A"")=X,A4A7B(""B"")=Y,A4A7B(""HAY"")=$T(@X+Y) D HORSE^A4A7B"
F Z=$P(^UTILITY("A4A7B","CKPT"),"^",2):1:$S($G(^UTILITY("A4A7B","SECTION"))'="":$P(^("SECTION"),"^",2),1:28) S A4A7B("FIRST")=$P(A4A7B("STRING"),"^",Z-1),A4A7B("LAST")=$P(A4A7B("STRING"),"^",Z) Q:^UTILITY("A4A7B","RUN")="STOP" D
.X A4A7B("FIND"),A4A7B("LINE") K ^UTILITY("A4A7B0") S $P(^("CKPT"),"^",2)=($P(^UTILITY("A4A7B","CKPT"),"^",2)+1)
Q S:^UTILITY("A4A7B","RUN")="RUN" ^UTILITY("A4A7B","RUN")="FINISHED" K A4A7B Q
FILE F A4A7B("C")="ACT","SCR" Q:'$D(^DD(A4A7B("A"),0,A4A7B("C"))) S A4A7B("B")=A4A7B("C"),A4A7B("HAY")=^DD(A4A7B("A"),0,A4A7B("B")),A4A7B("NAIL")=A4A7B("C") D HORSE
S A4A7B("C")="ID" S A4A7B("B")="" F S A4A7B("B")=$O(^DD(A4A7B("A"),0,A4A7B("C"),A4A7B("B"))) Q:A4A7B("B")="" S A4A7B("HAY")=^DD(A4A7B("A"),0,A4A7B("C"),A4A7B("B")),A4A7B("NAIL")=A4A7B("C") D HORSE
Q
HORSE F A4A7B("HORSE")=3,6,16,20 D
.I A4A7B("HAY")[("^DIC("_A4A7B("HORSE")_",") D NEEDLE
.F A4A7B("NEEDLE")="DIC=","DIE=","(DIC,DIE)=","(DIE,DIC)=" I A4A7B("HAY")[A4A7B("NEEDLE"),+$P(A4A7B("HAY"),A4A7B("NEEDLE"),2)=A4A7B("HORSE") D NEEDLE
K A4A7B("HAY"),A4A7B("NAIL"),A4A7B("HORSE"),A4A7B("NEEDLE") Q
NEEDLE S ^UTILITY("A4A7B","XQ82",A4A7B("A"),A4A7B("B"),A4A7B("HORSE"),A4A7B("NAIL"))=A4A7B("HAY") Q
STOP S ^UTILITY("A4A7B","RUN")="STOP" Q
RESTART S ^UTILITY("A4A7B","RUN")="RUN" D NODE^A4A7B0 G @$P(^UTILITY("A4A7B","CKPT"),"^")
NAIL S A4A7B("NAIL")=$S($D(A4A7B("NODE",A4A7B("C"))):A4A7B("NODE",A4A7B("C")),$D(A4A7B("NODE",A4A7B("C")\1)):A4A7B("NODE",A4A7B("C")\1),1:"M*"_A4A7B("C")) Q
TASK S ZTRTN=$S('($D(^UTILITY("A4A7B","CKPT"))):"^A4A7B",^UTILITY("A4A7B","RUN")="FINISHED":"Q^A4A7B",1:"RESTART^A4A7B"),ZTDESC="FIND 3/6/16/20",ZTIO="",ZTPRI=1,ZTSAVE("*")="" D ^%ZTLOAD W !,"TASK",?20,$G(ZTSK) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HA4A7B 5106 printed Nov 22, 2024@17:12:24 Page 2
A4A7B ;CFB/SF/TUSC; NEW PERSON FILE 3/6/16/20 LOCATOR ;05/28/97 14:40
+1 ;;1.01;NEW PERSON;**9,10**;2/9/96
+2 DO ^A4A7B0
DO PARTIAL^A4A7B0
IF $DATA(^UTILITY("A4A7B","SECTION"))!($DATA(ANS))
GOTO Q
DATADIC ;start looping though the data dictionary
+1 SET A4A7B("START")=$PIECE(^UTILITY("A4A7B","CKPT"),"^",2)
SET A4A7B("STOP")=$SELECT($GET(^UTILITY("A4A7B","SECTION"))'="":$PIECE(^("SECTION"),"^",3),1:99999999999)
+2 FOR A4A7B("A")=A4A7B("START"):0:A4A7B("STOP")
SET $PIECE(^UTILITY("A4A7B","CKPT"),"^",2)=A4A7B("A")
SET A4A7B("A")=$ORDER(^DD(A4A7B("A")))
if A4A7B("A")'>0
QUIT
if ^UTILITY("A4A7B","RUN")="STOP"
GOTO Q
Begin DoDot:1
+3 IF (A4A7B("A")\1=3!(A4A7B("A")\1=6)!(A4A7B("A")\1=16)!(A4A7B("A")\1=20)!(A4A7B("A")\1=200))
QUIT
+4 DO FILE
SET A4A7B("B")=""
FOR
SET A4A7B("B")=$ORDER(^DD(A4A7B("A"),A4A7B("B")))
if A4A7B("B")=""
QUIT
IF A4A7B("B")>0
Begin DoDot:2
+5 IF +A4A7B("B")
Begin DoDot:3
+6 KILL A4A7B(0)
SET A4A7B(0)=$GET(^DD(A4A7B("A"),A4A7B("B"),0))
if A4A7B(0)=""
QUIT
SET A4A7B(0,5)=$PIECE(A4A7B(0),"^",5,999)
FOR A4A7B=1:1:4
SET A4A7B(0,A4A7B)=$PIECE(A4A7B(0),"^",A4A7B)
+7 if +A4A7B(0,2)
QUIT
+8 IF A4A7B(0,2)["V"
FOR A4A7B("C")=0:0
SET A4A7B("C")=$ORDER(^DD(A4A7B("A"),A4A7B("B"),"V","B",A4A7B("C")))
if A4A7B("C")'>0
QUIT
SET A4A7B("NAIL")="V"
SET A4A7B("HAY")=$GET(^DIC(A4A7B("C"),0,"GL"))
DO HORSE
+9 IF A4A7B(0,2)'["S"
IF A4A7B(0,3)["DIC("
SET A4A7B("HAY")="^"_A4A7B(0,3)
SET A4A7B("NAIL")="PTR"
DO HORSE
+10 IF A4A7B(0,5)["^DIC("
SET A4A7B("HAY")=A4A7B(0,5)
SET A4A7B("NAIL")="INP"
DO HORSE
End DoDot:3
+11 SET A4A7B("C")=""
FOR
SET A4A7B("C")=$ORDER(@A4A7B("IND",3))
if A4A7B("C")=""
QUIT
SET A4A7B("D")=""
SET A4A7B("D")=$ORDER(@A4A7B("IND",4))
IF A4A7B("C")'="0"
Begin DoDot:3
+12 IF A4A7B("D")=""
SET A4A7B("HAY")=@A4A7B("IND",3)
DO NAIL
DO HORSE
QUIT
+13 SET A4A7B("D")=$SELECT(A4A7B("C")=1:0,1:"")
FOR
SET A4A7B("D")=$ORDER(@A4A7B("IND",4))
if A4A7B("D")=""
QUIT
SET A4A7B("E")=""
FOR
SET A4A7B("E")=$ORDER(@A4A7B("IND",5))
if A4A7B("E")=""
QUIT
Begin DoDot:4
+14 SET A4A7B("HAY")=$GET(@A4A7B("IND",5))
IF A4A7B("HAY")'=""
SET A4A7B=$GET(^(0))
DO NAIL
IF A4A7B("NAIL")="CR"
SET A4A7B("NAIL")=A4A7B("NAIL")_"*"_A4A7B
DO HORSE
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 if $DATA(^UTILITY("A4A7B","SECTION"))
QUIT
+16 SET ^UTILITY("A4A7B","CKPT")="DIE^DIE(0)"
DIE ;
+1 SET A4A7B("DIE")="^"_$PIECE(^UTILITY("A4A7B","CKPT"),"^",2)
SET A4A7B("TEST")=$PIECE(A4A7B("DIE"),"0)")
FOR
SET A4A7B("DIE")=$QUERY(@A4A7B("DIE"))
if ^UTILITY("A4A7B","RUN")="STOP"
QUIT
if A4A7B("DIE")'[A4A7B("TEST")
QUIT
if '+$PIECE(A4A7B("DIE"),A4A7B("TEST"),2)
QUIT
Begin DoDot:1
+2 IF $PIECE(A4A7B("DIE"),A4A7B("TEST"),2)?.N1",0)"
SET A4A7B("A")=$PIECE($GET(@A4A7B("DIE")),"^")
+3 SET A4A7B("NAIL")=A4A7B("TEST")
IF A4A7B("DIE")["^DIST("
SET A4A7B("NAIL")=$PIECE(A4A7B("DIE"),",")
+4 SET A4A7B("B")=$PIECE(A4A7B("DIE"),",",2,999)
+5 IF $DATA(@A4A7B("DIE"))
SET A4A7B("HAY")=@A4A7B("DIE")
DO HORSE
+6 IF +$PIECE(A4A7B("DIE"),"^DIE(",2)>(+$PIECE($PIECE(^UTILITY("A4A7B","CKPT"),"^",2),"DIE(",2))
SET $PIECE(^UTILITY("A4A7B","CKPT"),"^",2)=$PIECE(A4A7B("DIE"),"^",2,999)
End DoDot:1
+7 if $DATA(^UTILITY("A4A7B","SECTION"))
QUIT
+8 SET X=A4A7B("TEST")
IF X'="^DIST(.404,"
SET $PIECE(^UTILITY("A4A7B","CKPT"),"^",2)=$SELECT(X="^DIE(":"DIBT(0)",X="^DIBT(":"DIPT(0)",X="^DIPT(":"DD(""FUNC"",0)",X="^DD((""FUNC"",":"DIST(.403,0)",1:"DIST(.404,0)")
GOTO DIE
+9 KILL A4A7B("DIE"),A4A7B("TEST")
+10 SET ^UTILITY("A4A7B","CKPT")="ROU^2"
KILL ^UTILITY("A4A7B0")
ROU SET A4A7B("STRING")="^A^B^C^D^E^F^G^H^I^J^K^L^M^N^O^P^Q^R^S^T^U^V^W^X^Y^Z^ZZZZZ"
+1 SET A4A7B("FIND")="F S A4A7B(""FIRST"")=$O(^$R(A4A7B(""FIRST""))) Q:A4A7B(""FIRST"")="""" Q:A4A7B(""FIRST"")]A4A7B(""LAST"") S ^UTILITY(""A4A7B0"",A4A7B(""FIRST""))="""""
+2 SET A4A7B("LINE")="S X="""" F S X=$O(^UTILITY(""A4A7B0"",X)) Q:X="""" F Y=0:1 ZL @X Q:$T(@X+Y)="""" S A4A7B(""NAIL"")=""ROU"",A4A7B(""A"")=X,A4A7B(""B"")=Y,A4A7B(""HAY"")=$T(@X+Y) D HORSE^A4A7B"
+3 FOR Z=$PIECE(^UTILITY("A4A7B","CKPT"),"^",2):1:$SELECT($GET(^UTILITY("A4A7B","SECTION"))'="":$PIECE(^("SECTION"),"^",2),1:28)
SET A4A7B("FIRST")=$PIECE(A4A7B("STRING"),"^",Z-1)
SET A4A7B("LAST")=$PIECE(A4A7B("STRING"),"^",Z)
if ^UTILITY("A4A7B","RUN")="STOP"
QUIT
Begin DoDot:1
+4 XECUTE A4A7B("FIND")
XECUTE A4A7B("LINE")
KILL ^UTILITY("A4A7B0")
SET $PIECE(^("CKPT"),"^",2)=($PIECE(^UTILITY("A4A7B","CKPT"),"^",2)+1)
End DoDot:1
Q if ^UTILITY("A4A7B","RUN")="RUN"
SET ^UTILITY("A4A7B","RUN")="FINISHED"
KILL A4A7B
QUIT
FILE FOR A4A7B("C")="ACT","SCR"
if '$DATA(^DD(A4A7B("A"),0,A4A7B("C")))
QUIT
SET A4A7B("B")=A4A7B("C")
SET A4A7B("HAY")=^DD(A4A7B("A"),0,A4A7B("B"))
SET A4A7B("NAIL")=A4A7B("C")
DO HORSE
+1 SET A4A7B("C")="ID"
SET A4A7B("B")=""
FOR
SET A4A7B("B")=$ORDER(^DD(A4A7B("A"),0,A4A7B("C"),A4A7B("B")))
if A4A7B("B")=""
QUIT
SET A4A7B("HAY")=^DD(A4A7B("A"),0,A4A7B("C"),A4A7B("B"))
SET A4A7B("NAIL")=A4A7B("C")
DO HORSE
+2 QUIT
HORSE FOR A4A7B("HORSE")=3,6,16,20
Begin DoDot:1
+1 IF A4A7B("HAY")[("^DIC("_A4A7B("HORSE")_",")
DO NEEDLE
+2 FOR A4A7B("NEEDLE")="DIC=","DIE=","(DIC,DIE)=","(DIE,DIC)="
IF A4A7B("HAY")[A4A7B("NEEDLE")
IF +$PIECE(A4A7B("HAY"),A4A7B("NEEDLE"),2)=A4A7B("HORSE")
DO NEEDLE
End DoDot:1
+3 KILL A4A7B("HAY"),A4A7B("NAIL"),A4A7B("HORSE"),A4A7B("NEEDLE")
QUIT
NEEDLE SET ^UTILITY("A4A7B","XQ82",A4A7B("A"),A4A7B("B"),A4A7B("HORSE"),A4A7B("NAIL"))=A4A7B("HAY")
QUIT
STOP SET ^UTILITY("A4A7B","RUN")="STOP"
QUIT
RESTART SET ^UTILITY("A4A7B","RUN")="RUN"
DO NODE^A4A7B0
GOTO @$PIECE(^UTILITY("A4A7B","CKPT"),"^")
NAIL SET A4A7B("NAIL")=$SELECT($DATA(A4A7B("NODE",A4A7B("C"))):A4A7B("NODE",A4A7B("C")),$DATA(A4A7B("NODE",A4A7B("C")\1)):A4A7B("NODE",A4A7B("C")\1),1:"M*"_A4A7B("C"))
QUIT
TASK SET ZTRTN=$SELECT('($DATA(^UTILITY("A4A7B","CKPT"))):"^A4A7B",^UTILITY("A4A7B","RUN")="FINISHED":"Q^A4A7B",1:"RESTART^A4A7B")
SET ZTDESC="FIND 3/6/16/20"
SET ZTIO=""
SET ZTPRI=1
SET ZTSAVE("*")=""
DO ^%ZTLOAD
WRITE !,"TASK",?20,$GET(ZTSK)
QUIT
