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

YSESP ;SLC/DCM-PARSE RESPONSES AND CHECK VALIDITY OF RESPONSE ENTRIES AND LINKS ; 7/7/89  10:17 ;
 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
 ;DECISION EXPERT SYSTEM (VERSION 1.0) FOR MENTAL HEALTH PACKAGE - DWIGHT MCDANIEL / REGION 5 ISC, SLC
 ;
 ; Called by DD(628.23 and routine YSESL
E G EN
LEX 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))
 Q
CNODE S DBN=$O(^YS(628_"""B"","_Q_PCE1_Q_",0)")) D:DBN<0 NNODE Q
CNODE1 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)"))
 D:DBN<0 NNODE Q
CNODE2 D CNODE1 S DB1=DB_DBN_",2,""B"",",DBN=$O(@(DB1_Q_PCE2_Q_",0)"))
 D:DBN<0 NNODE Q
CNODE3 S DB="^YS(628,",DB1=DB_"""B"",",DBN=$O(@(DB1_Q_A5ASYS_Q_",0)")) D:DBN'>0 NSYS Q
NNODE S:'$D(EF("******  WARNING: UNDEFINED NODE << "_PCE1_" >>  ******")) EF("******  WARNING: UNDEFINED NODE << "_PCE1_" >> ******")="" Q
NSYS S:'$D(EF("******  WARNING: THE SYSTEM << "_PCE1_" >> DOES NOT EXIST")) ER("******  WARNING:  THE SYSTEM << "_PCE1_" >> DOES NOT EXIST")="" Q
NRSP 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
 Q
EN S Q="""",EST=ESLNKS D ULC^YSESUT S ESLNKS=EST,A5ARSP="",TMP=ESLNKS,TMP1=A5ARSP,RF=0,EF=0 K EST
 I ESLNKS="[O]",TMP1="",$D(@(DIE_D0_",2)")) S (TMP1,A5ARSP)=^(2)
PICK F ESI=1:1 S PCE=$P(TMP,",",ESI) Q:PCE=""  D PARSE
 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)
 K R,DB,RF,DB1,DBN,PCE,PCE1,PCE2,TMP,TMP1,L,ESLNKS S ESI="" Q
PARSE I $S(PCE="[0]":1,PCE="[D]":1,1:0),TMP'["$" Q
 I PCE="[O]",TMP1]"" Q
 S PCE1=$P(PCE,"::") I TMP1'[PCE1,PCE1'["$" D NRSP
 I " "[PCE1!(",.@%^_[]~"[PCE1) S:'$D(EF("NO PUNCTUATION SYMBOLS ARE ALLOWED BEFORE '::' CHARACTER")) EF("NO PUNCTUATION SYMBOLS ARE ALLOWED BEFORE '::' CHARACTER")=""
 I PCE1?.E2"$".E S R="$$" I TMP1'[R D NRSP
 I PCE1?.E1"$".E1"$".E S R=$P(TMP1,"$",2) D:PCE1'[R NRSP
 S PCE1=$P(PCE,"::",2) I PCE1?.E1"[".E1"]" S PCE1=$P($P(PCE,"[",2),"]") D CNODE Q
 I PCE1?1"<".E1">" S PCE1=$P($P(PCE,"<",2),">") D CNODE1 Q
 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
 I PCE1?1"{".E1"<".E1">"1"}" S A5ASYS=$P($P(PCE1,"{",2),"<") D CNODE3 S PCE1=$P($P(PCE1,"<",2),">") D CNODE1 Q
 I PCE1["[0]" S:'$D(EF("ONLY GOAL NODES CAN CONTAIN THE CHARACTER '0'")) EF("ONLY GOAL NODED CAN CONTAIN THE CHARACTER '0'")="" Q
 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")=""
 I PCE1'["[",(PCE1'["]"),PCE1]"" S:'$D(EF("A LINK IS MISSING << "_PCE_" >>")) EF("A LINK IS MISSING << "_PCE_">>")="",EF("A NODE IS MISSING")=""
 I PCE1'["[",PCE1["]",(PCE1]"") S:'$D(EF("A RIGHT BRACKET IS MISSING << "_PCE1_" >>")) EF("A RIGHT BRACKET IS MISSING << "_PCE1_">>")=""
 I PCE1'["]",PCE1["[",PCE1]"" S:'$D(EF("A LEFT BRACKET IS MISSING << "_PCE1_" >>")) EF("A LEFT BRACKET IS MISSING << "_PCE1_" >>")=""
 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")=""
 I PCE1["<",PCE1'[">" S:'$D(EF("A RIGHT ANGLE BRACKET '>' IS MISSING")) EF("A RIGHT ANGLE BRACKET '>' IS MISSING")=""
 I PCE1[">",PCE1'["<" S:'$D(EF("A LEFT ANGLE BRACKET '<' IS MISSING")) EF("A LEFT ANGLE BRACKET '<' IS MISSING")="" Q
 S:'$D(EF("ERROR IN ENTRY")) EF("ERROR IN ENTRY")="" Q