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