source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSESP.m@ 1046

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

initial load of WorldVistAEHR
File size: 3.5 KB
Line 
1YSESP ;SLC/DCM-PARSE RESPONSES AND CHECK VALIDITY OF RESPONSE ENTRIES AND LINKS ; 7/7/89 10:17 ;
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
4 ;
5 ; Called by DD(628.23 and routine YSESL
6E G EN
7LEX F ESI=1:1 S P=$E(TMP,ESI) Q:P="" I P?1" " S TMP=$E(TMP,1,ESI-1)_$E(TMP,ESI+1,$L(TMP))
8 Q
9CNODE S DBN=$O(^YS(628_"""B"","_Q_PCE1_Q_",0)")) D:DBN<0 NNODE Q
10CNODE1 S DB="^YS(628,",DB1=DB_"""B"",",DBN=$O(@(DB1_Q_A5ASYS_Q_",0)")),DB=DB_DBN_",1,",DB1=DB_"""B"",",DBN=$O(@(DB1_Q_PCE1_Q_",0)"))
11 D:DBN<0 NNODE Q
12CNODE2 D CNODE1 S DB1=DB_DBN_",2,""B"",",DBN=$O(@(DB1_Q_PCE2_Q_",0)"))
13 D:DBN<0 NNODE Q
14CNODE3 S DB="^YS(628,",DB1=DB_"""B"",",DBN=$O(@(DB1_Q_A5ASYS_Q_",0)")) D:DBN'>0 NSYS Q
15NNODE S:'$D(EF("****** WARNING: UNDEFINED NODE << "_PCE1_" >> ******")) EF("****** WARNING: UNDEFINED NODE << "_PCE1_" >> ******")="" Q
16NSYS S:'$D(EF("****** WARNING: THE SYSTEM << "_PCE1_" >> DOES NOT EXIST")) ER("****** WARNING: THE SYSTEM << "_PCE1_" >> DOES NOT EXIST")="" Q
17NRSP I '$D(EF("THE RESPONSES GIVEN IN THE LINKS DO NOT MATCH THE RESPONSES DEFINED")) S EF("THE RESPONSES GIVEN IN THE LINKS DO NOT MATCH THE RESPONSES DEFINED")="",EF=1 Q
18 Q
19EN S Q="""",EST=ESLNKS D ULC^YSESUT S ESLNKS=EST,A5ARSP="",TMP=ESLNKS,TMP1=A5ARSP,RF=0,EF=0 K EST
20 I ESLNKS="[O]",TMP1="",$D(@(DIE_D0_",2)")) S (TMP1,A5ARSP)=^(2)
21PICK F ESI=1:1 S PCE=$P(TMP,",",ESI) Q:PCE="" D PARSE
22 S L="",L=$O(EF(ESI)) I L]"" W $C(7),!!! F ESJ=0:0 S L=$O(EF(ESI)) Q:L="" W ?(80-$L(L))\2,L,! K EF(L)
23 K R,DB,RF,DB1,DBN,PCE,PCE1,PCE2,TMP,TMP1,L,ESLNKS S ESI="" Q
24PARSE I $S(PCE="[0]":1,PCE="[D]":1,1:0),TMP'["$" Q
25 I PCE="[O]",TMP1]"" Q
26 S PCE1=$P(PCE,"::") I TMP1'[PCE1,PCE1'["$" D NRSP
27 I " "[PCE1!(",.@%^_[]~"[PCE1) S:'$D(EF("NO PUNCTUATION SYMBOLS ARE ALLOWED BEFORE '::' CHARACTER")) EF("NO PUNCTUATION SYMBOLS ARE ALLOWED BEFORE '::' CHARACTER")=""
28 I PCE1?.E2"$".E S R="$$" I TMP1'[R D NRSP
29 I PCE1?.E1"$".E1"$".E S R=$P(TMP1,"$",2) D:PCE1'[R NRSP
30 S PCE1=$P(PCE,"::",2) I PCE1?.E1"[".E1"]" S PCE1=$P($P(PCE,"[",2),"]") D CNODE Q
31 I PCE1?1"<".E1">" S PCE1=$P($P(PCE,"<",2),">") D CNODE1 Q
32 I PCE1?1"{".E1"<".E1"[".E1"]"1">"1"}" S PCE3=PCE1,A5ASYS=$P($P(PCE1,"{",2),"<"),PCE1=$P($P(PCE3,"<",2),"["),PCE2=$P($P(PCE3,"[",2),"]") D CNODE1 K PCE3 Q
33 I PCE1?1"{".E1"<".E1">"1"}" S A5ASYS=$P($P(PCE1,"{",2),"<") D CNODE3 S PCE1=$P($P(PCE1,"<",2),">") D CNODE1 Q
34 I PCE1["[0]" S:'$D(EF("ONLY GOAL NODES CAN CONTAIN THE CHARACTER '0'")) EF("ONLY GOAL NODED CAN CONTAIN THE CHARACTER '0'")="" Q
35 I PCE'["::" S:'$D(EF("A RESPONSE MUST BE SEPARATED FROM ITS GOAL NODE BY THE '::' DELIMITER")) EF("A RESPONSE MUST BE SEPARATED FROM ITS GOAL NODE BY THE '::' DELIMITER")=""
36 I PCE1'["[",(PCE1'["]"),PCE1]"" S:'$D(EF("A LINK IS MISSING << "_PCE_" >>")) EF("A LINK IS MISSING << "_PCE_">>")="",EF("A NODE IS MISSING")=""
37 I PCE1'["[",PCE1["]",(PCE1]"") S:'$D(EF("A RIGHT BRACKET IS MISSING << "_PCE1_" >>")) EF("A RIGHT BRACKET IS MISSING << "_PCE1_">>")=""
38 I PCE1'["]",PCE1["[",PCE1]"" S:'$D(EF("A LEFT BRACKET IS MISSING << "_PCE1_" >>")) EF("A LEFT BRACKET IS MISSING << "_PCE1_" >>")=""
39 I PCE1'["[",PCE1'["]",PCE1]"" S:'$D(EF("A NODE MUST BE IDENTIFIED BY PLACING BRACKETS '[]' AROUND IT")) EF("A NODE MUST BE IDENTIFIED BY PLACING BRACKETS AROUND IT")=""
40 I PCE1["<",PCE1'[">" S:'$D(EF("A RIGHT ANGLE BRACKET '>' IS MISSING")) EF("A RIGHT ANGLE BRACKET '>' IS MISSING")=""
41 I PCE1[">",PCE1'["<" S:'$D(EF("A LEFT ANGLE BRACKET '<' IS MISSING")) EF("A LEFT ANGLE BRACKET '<' IS MISSING")="" Q
42 S:'$D(EF("ERROR IN ENTRY")) EF("ERROR IN ENTRY")="" Q
Note: See TracBrowser for help on using the repository browser.