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/A4A7B.m@ 1073

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