source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSESE.m@ 897

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

initial load of FOIAVistA 6/30/08 version

File size: 1.7 KB
Line 
1YSESE ;SLC/DCM-MENU DRIVER FOR OPTIONS INVOLVED WITH EDITING A DECISION SUPPORT SYSTEM ; 6/27/89 11:45 ;
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 EN
5PUSH S ST=ST+1,SDIC(ST)=DIC,SDIC0(ST)=DIC(0),ESDBP(ST)=ESDBP,ESDBP1(ST)=ESDBP1 Q
6 Q
7POP 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
8 Q
9EN S ST=0,OPT="",ESDBP="^YS(628,",DIC=ESDBP,ESDBP1=ESDBP_"""B"","
10MEN W @IOF,!?4,$E(STR,1,18)," EDIT A DECISION SUPPORT ALGORITHM ",$E(STR,1,18),!?4,"**",?75,"**",!?4
11 S ESI="" W ?4,"** " F ESJ=0:1 S ESI=$O(@(ESDBP1_Q_ESI_Q_")")) Q:ESI="" W ESI,?40 W:ESJ#2 ?75,"**",!?4,"** "
12 W ?75,"**",!?4,$E(STR,1,17)," AVAILABLE DECISION SUPPORT SYSTEMS ",$E(STR,1,17),!
13 S DLAYGO=628,DIC(0)="AELMQZ",DIC("A")="Select a Decision Support System: " D ^DIC G:Y=-1 END S GN=$P(Y,U),A5ASYS=$P(Y(0),U)
14 G:Y=-1 END D PUSH
15MEN1 D PUSH S ESDBP=ESDBP_GN_",",ESDBP1=ESDBP_"1,"_"""B"",",NODE1="^628.02^^0"
16 S TB=(80-($L(A5ASYS)+17))\2,TC=(80-($L(A5ASYS)+24))\2 W @IOF,!!,$E(STR,1,TC),?TB,A5ASYS_" MAJOR SYMPTOM",?(80-TC-1),$E(STR,1,TC),!,"**",?77,"**",!,"** "
17 S ESI="" F ESJ=0:1 S ESI=$O(@(ESDBP1_Q_ESI_Q_")")) Q:ESI="" W ESI,?41 W:ESJ#2 ?77,"**",!,"** "
18 W ?77,"**",!,STR,!!
19 S ESDBP=ESDBP_"1,",DIC=ESDBP,DIC("A")="Select a Decision Support Major Symptom: ",DA(1)=GN,ESDBP1=ESDBP_"2,"_"""B"",",TB=($L(A5ASYS)\2)+7
20 I '$D(@(DIC_"0)")) S @(DIC_"0)")=NODE1
21 D ^DIC S YSTOUT=$D(DTOUT) Q:YSTOUT S GN1=$P(Y,U),A5ALG=$P(Y,U,2)
22 I Y'>0 D POP G MEN
23 S DA=GN1,DA(1)=GN,DR=2,DR(1,628.02)=2,DIE=DIC D ^DIE S YSTOUT=$D(DTOUT) Q:YSTOUT
24F S ESDBP1=ESDBP_GN1_",2,""B""," D ED^YSESED
25 D POP G MEN1
26END K ESDBP(ST),ESDBP1(ST),A5ASYS,NODE1,LND G ^YSESM
Note: See TracBrowser for help on using the repository browser.