source: FOIAVistA/tag/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSESL.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.2 KB
Line 
1YSESL ;SLC/DCM-ADD/EDIT/DELETE LINKS TO NODES IN DECISION SUPPORT SYSTEM ; 6/28/89 08:20 ;08/11/93 09:39
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;DECISION EXPERT SYSTEM (VERSION 1.0) FOR MENTAL HEALTH PACKAGE - DWIGHT MCDANIEL / REGION 5 ISC, SLC
4E G ED
5PUSH S ST=ST+1,SDIC(ST)=DIC,SDIC0(ST)=DIC(0),ESDBP(ST)=ESDBP,ESDBP1(ST)=ESDBP1 Q
6POP S DIC=SDIC(ST),DIC(0)=SDIC0(ST),ESDBP=ESDBP(ST),ESDBP1=ESDBP1(ST) K SDIC(ST),ESDBP(ST),ESDBP1(ST) S ST=ST-1 Q
7SET S @(ESDBP_GN2_",2)")=A5ARSP_"^"_ESLNKS,LK="" G ED1
8FIND S ESI=LND,ESK=1 F ESJ=1:1 S ESI=$O(@(ESDBP1_Q_ESI_Q_")")) Q:ESI="" I $E(ESI,1,$L(LND))=LND S ND(ESK)=ESI,ESK=ESK+1
9 S ESK=ESK-1 I ESK<1 S GN2=-1 W $C(7)," ??" Q
10 I ESK>1 W $C(7),!! F ESI=1:1:ESK W ESI,". ",ND(ESI),!
11F1 I ESK>1 W !!,"Which node? (1-",ESK,") " R ESJ:DTIME I '$T!(ESJ="") S LND=-1 Q
12 I ESK>1,ESJ>ESK!(ESJ<1) W $C(7) G F1
13 S:ESK=1 ESJ=1 S GN2=$O(@(ESDBP1_Q_ND(ESJ)_Q_",0)")) W:GN2>0 $S((ESK-1)>1:" "_$P(@(ESDBP_GN2_",0)"),U),1:$P($E(@(ESDBP_GN2_",0)"),$L(LND)+1,99),U))
14 Q
15ED K A5ARSP,ESLNKS D PUSH W @IOF,!?(80-(($L(A5ALG)+37))\2),"LINK << ",A5ALG," >> DECISION ALGORITHM NODES",!
16 S ESDBP=ESDBP_GN1_",2,"
17ED1 S (Y1,Y2,Y3)="" W !!,"Node Being Linked: " R LND:DTIME G:'$T!(LND="") END I LND["?" D HLP^YSESH:LND?1"?",LST^YSESH:LND["??" G ED1
18 S GN2=$O(@(ESDBP1_Q_LND_Q_",0)")) I GN2']"" D FIND I GN2<1 W $C(7)," ??" G ED1
19 I $D(@(ESDBP_GN2_",2)")) S A5ARSP=$P(^(2),U),ESLNKS=$P(^(2),U,2) I $D(A5ARSP),A5ARSP]"",$D(ESLNKS),ESLNKS]"" S LK=ESLNKS D ^YSESR G EDIT
20ADD S:'$D(ESLNKS) (LK,ESLNKS)="" I '$D(A5ARSP) S A5ARSP=""
21 I A5ARSP="",ESLNKS'="[0]" R !!,"Is this a Goal Node? (Y/N) // ",A5AX:DTIME G:'$T ED1 I "Nn"[A5AX D ^YSESR G:A5ARSP]"" EDIT
22 I A5ARSP="",ESLNKS'="[0]","Nn"[A5AX D ERROR^YSESH G ED1
23AD1 S LK=ESLNKS W !!,"Definde Responses: ",$S(ESLNKS["[0]":" (THIS IS A GOAL NODE) ",1:"")_$S(A5ARSP=0:"NO RESPONSES DEFINED",A5ARSP]"":A5ARSP,1:""),!!
24 W "LINKS: "_$S(ESLNKS]"":ESLNKS_" // ",1:" // ") R ESLNKS:DTIME G:'$T!(ESLNKS="") ED1 I ESLNKS["?" D HLP2^YSESH S ESLNKS=LK G AD1
25 I A5ARSP="",ESLNKS'["0" D ERROR^YSESH G ED1
26 D ^YSESP S:EF=0 @(ESDBP_GN2_",2)")=A5ARSP_"^"_ESLNKS W:EF=1 !!,"****** NOTHING CHANGED ******",! K RF S ESLNKS=LK G ED1
27 G ED1
28EDIT W !!,"Prompted Responses: ",$S(ESLNKS["[0]":" (THIS IS A GOAL NODE) ",1:"")_A5ARSP,!,"Defined Links: ",ESLNKS
29 I ESLNKS="" G ADD
30EDT W !!,"Replace: " R ESJ:DTIME I '$T K A5ARSP S (ESLNKS,LK)="" G ED1
31 I ESLNKS="" D ADD G ED1
32 I ESJ="",LK=ESLNKS K A5ARSP S (ESLNKS,LK)="" G ED1
33 I ESJ="",ESLNKS'=LK D ^YSESP G:EF=0 SET I EF=1 W !!?15,"****** NOTHING CHANGED ******" K ER S ESLNKS=LK G ED1
34 I ESJ["?" D HLP2^YSESH G EDIT
35 I ESJ'["..." G:$F(ESLNKS,ESJ,1)>0 2 W $C(7)," ??" G EDIT
36 S ESJ=$P(ESJ,"..."),ESJ=$F(ESLNKS,ESJ,1) I ESJ=0 W $C(7)," ??" G EDIT
37 S ESJ=$F(ESLNKS,ESJ,1) I ESJ=0 W $C(7)," ??" G EDIT
381 S Y=$E(ESLNKS,ESJ,1) W !,"With: " R Y1:DTIME G:'$T!(Y1="") ED1 I Y1["?" D HLP3^YSESH G 1
39 S ESLNKS=Y_Y1 D ^YSESP I EF=1 W !!,"****** NOTHING CHANGED ******",! K EF S ESLNKS=LK G EDIT
40 W !!,"New Defined Links: ",ESLNKS G EDT
412 S Y1=$P(ESLNKS,ESJ),Y3=$E(ESLNKS,$F(ESLNKS,ESJ,1),99)
42A2 W !,"With: " R Y2:DTIME G:'$T!(Y2="") ED1 I Y2["?" D HLP3^YSESH G A2
43 S ESLNKS=Y1_Y2_Y3 W !!,"New Links: ",ESLNKS G EDT
44END K K,Y1,Y2,Y3,Z,ESK,ESLNKS,LK,ND S ESI="" D POP Q
Note: See TracBrowser for help on using the repository browser.