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

Last change on this file since 1608 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.9 KB
Line 
1A4A7B ;CFB/SF/TUSC; NEW PERSON FILE 3/6/16/20 LOCATOR ;05/28/97 14:40
2 ;;1.01;NEW PERSON;**9,10**;2/9/96
3 D ^A4A7B0,PARTIAL^A4A7B0 I $D(^UTILITY("A4A7B","SECTION"))!($D(ANS)) G Q
4DATADIC ;start looping though the data dictionary
5 S A4A7B("START")=$P(^UTILITY("A4A7B","CKPT"),"^",2),A4A7B("STOP")=$S($G(^UTILITY("A4A7B","SECTION"))'="":$P(^("SECTION"),"^",3),1:99999999999)
6 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
7 .I (A4A7B("A")\1=3!(A4A7B("A")\1=6)!(A4A7B("A")\1=16)!(A4A7B("A")\1=20)!(A4A7B("A")\1=200)) Q
8 .D FILE S A4A7B("B")="" F S A4A7B("B")=$O(^DD(A4A7B("A"),A4A7B("B"))) Q:A4A7B("B")="" I A4A7B("B")>0 D
9 ..I +A4A7B("B") D
10 ...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)
11 ...Q:+A4A7B(0,2)
12 ...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
13 ...I A4A7B(0,2)'["S",A4A7B(0,3)["DIC(" S A4A7B("HAY")="^"_A4A7B(0,3),A4A7B("NAIL")="PTR" D HORSE
14 ...I A4A7B(0,5)["^DIC(" S A4A7B("HAY")=A4A7B(0,5),A4A7B("NAIL")="INP" D HORSE
15 ..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
16 ...I A4A7B("D")="" S A4A7B("HAY")=@A4A7B("IND",3) D NAIL,HORSE Q
17 ...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
18 ....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
19 Q:$D(^UTILITY("A4A7B","SECTION"))
20 S ^UTILITY("A4A7B","CKPT")="DIE^DIE(0)"
21DIE ;
22 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
23 .I $P(A4A7B("DIE"),A4A7B("TEST"),2)?.N1",0)" S A4A7B("A")=$P($G(@A4A7B("DIE")),"^")
24 .S A4A7B("NAIL")=A4A7B("TEST") I A4A7B("DIE")["^DIST(" S A4A7B("NAIL")=$P(A4A7B("DIE"),",")
25 .S A4A7B("B")=$P(A4A7B("DIE"),",",2,999)
26 .I $D(@A4A7B("DIE")) S A4A7B("HAY")=@A4A7B("DIE") D HORSE
27 .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)
28 Q:$D(^UTILITY("A4A7B","SECTION"))
29 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
30 K A4A7B("DIE"),A4A7B("TEST")
31 S ^UTILITY("A4A7B","CKPT")="ROU^2" K ^UTILITY("A4A7B0")
32ROU 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"
33 S A4A7B("FIND")="F S A4A7B(""FIRST"")=$O(^$R(A4A7B(""FIRST""))) Q:A4A7B(""FIRST"")="""" Q:A4A7B(""FIRST"")]A4A7B(""LAST"") S ^UTILITY(""A4A7B0"",A4A7B(""FIRST""))="""""
34 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"
35 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
36 .X A4A7B("FIND"),A4A7B("LINE") K ^UTILITY("A4A7B0") S $P(^("CKPT"),"^",2)=($P(^UTILITY("A4A7B","CKPT"),"^",2)+1)
37Q S:^UTILITY("A4A7B","RUN")="RUN" ^UTILITY("A4A7B","RUN")="FINISHED" K A4A7B Q
38FILE 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
39 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
40 Q
41HORSE F A4A7B("HORSE")=3,6,16,20 D
42 .I A4A7B("HAY")[("^DIC("_A4A7B("HORSE")_",") D NEEDLE
43 .F A4A7B("NEEDLE")="DIC=","DIE=","(DIC,DIE)=","(DIE,DIC)=" I A4A7B("HAY")[A4A7B("NEEDLE"),+$P(A4A7B("HAY"),A4A7B("NEEDLE"),2)=A4A7B("HORSE") D NEEDLE
44 K A4A7B("HAY"),A4A7B("NAIL"),A4A7B("HORSE"),A4A7B("NEEDLE") Q
45NEEDLE S ^UTILITY("A4A7B","XQ82",A4A7B("A"),A4A7B("B"),A4A7B("HORSE"),A4A7B("NAIL"))=A4A7B("HAY") Q
46STOP S ^UTILITY("A4A7B","RUN")="STOP" Q
47RESTART S ^UTILITY("A4A7B","RUN")="RUN" D NODE^A4A7B0 G @$P(^UTILITY("A4A7B","CKPT"),"^")
48NAIL 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
49TASK 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
Note: See TracBrowser for help on using the repository browser.