- YTSBAMIC ;SLC/KCM - Verify for BAM-IOP-CSG-SUD ; 01/08/2016
- ;;5.01;MENTAL HEALTH;**234**;DEC 30,1994;Build 38
- ;
- Q
- ;
- VERIFY(ARGS,RESULTS) ; Add inconsistency messages based on set of answers in ARGS
- N MSGCNT S MSGCNT=0
- I $$LT("q9136","q9137") D MSG("more","4","5A")
- I $$LT("q9138","q9139") D MSG("less","7A","6")
- I $$LT("q9138","q9140") D MSG("less","7B","6")
- I $$LT("q9138","q9141") D MSG("less","7C","6")
- I $$LT("q9138","q9142") D MSG("less","7D","6")
- I $$LT("q9138","q9143") D MSG("less","7E","6")
- I $$LT("q9138","q9144") D MSG("less","7F","6")
- I $$LT("q9138","q9145") D MSG("less","7G","6")
- I $$GTI("q9156","q9157") D MSG("more","5C","5B")
- S RESULTS("count")=MSGCNT
- Q
- LT(ID1,ID2) ; returns 1 if ID1 is less than ID2
- ; expects ARGS from VERIFY
- N VAL1,VAL2
- S VAL1=$E($G(ARGS(ID1)),2,9) S:VAL1=1156 VAL1=0 ; 1156 = skipped by rule
- I VAL1 S VAL1=+$P($G(^YTT(601.75,VAL1,0)),U,2) ; legacy value for compare
- S VAL2=$E($G(ARGS(ID2)),2,9) S:VAL2=1156 VAL2=0
- I VAL2 S VAL2=+$P($G(^YTT(601.75,VAL2,0)),U,2)
- I +VAL1<+VAL2 Q 1
- Q 0
- ;
- GTI(ID1,ID2) ; returns 1 if ID1 is more than ID2 (integer question)
- ; expects ARGS from VERIFY
- N VAL1,VAL2
- S VAL1=$G(ARGS(ID1)) S:VAL1="c1156" VAL1=0 ; 1156 = skipped by rule
- S VAL2=$G(ARGS(ID2)) S:VAL2="c1156" VAL2=0
- I +VAL1>+VAL2 Q 1
- Q 0
- ;
- MSG(REL,Q1,Q2) ; Add text of message to RESULTS
- ; expects MSGCNT, RESULTS from VERIFY
- N X,NOUN
- S NOUN=$S(Q1="5C":"drinks",1:"days")
- S X="There is an inconsistency: The number of "
- S X=X_NOUN_" entered in Question "_Q1
- S X=X_" should be equal to, or "_REL_" than,"
- S X=X_" the number of "_NOUN_" in Question "_Q2_"."
- S MSGCNT=MSGCNT+1,RESULTS("messages",MSGCNT)=X
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSBAMIC 1723 printed Feb 18, 2025@23:45:36 Page 2
- YTSBAMIC ;SLC/KCM - Verify for BAM-IOP-CSG-SUD ; 01/08/2016
- +1 ;;5.01;MENTAL HEALTH;**234**;DEC 30,1994;Build 38
- +2 ;
- +3 QUIT
- +4 ;
- VERIFY(ARGS,RESULTS) ; Add inconsistency messages based on set of answers in ARGS
- +1 NEW MSGCNT
- SET MSGCNT=0
- +2 IF $$LT("q9136","q9137")
- DO MSG("more","4","5A")
- +3 IF $$LT("q9138","q9139")
- DO MSG("less","7A","6")
- +4 IF $$LT("q9138","q9140")
- DO MSG("less","7B","6")
- +5 IF $$LT("q9138","q9141")
- DO MSG("less","7C","6")
- +6 IF $$LT("q9138","q9142")
- DO MSG("less","7D","6")
- +7 IF $$LT("q9138","q9143")
- DO MSG("less","7E","6")
- +8 IF $$LT("q9138","q9144")
- DO MSG("less","7F","6")
- +9 IF $$LT("q9138","q9145")
- DO MSG("less","7G","6")
- +10 IF $$GTI("q9156","q9157")
- DO MSG("more","5C","5B")
- +11 SET RESULTS("count")=MSGCNT
- +12 QUIT
- LT(ID1,ID2) ; returns 1 if ID1 is less than ID2
- +1 ; expects ARGS from VERIFY
- +2 NEW VAL1,VAL2
- +3 ; 1156 = skipped by rule
- SET VAL1=$EXTRACT($GET(ARGS(ID1)),2,9)
- if VAL1=1156
- SET VAL1=0
- +4 ; legacy value for compare
- IF VAL1
- SET VAL1=+$PIECE($GET(^YTT(601.75,VAL1,0)),U,2)
- +5 SET VAL2=$EXTRACT($GET(ARGS(ID2)),2,9)
- if VAL2=1156
- SET VAL2=0
- +6 IF VAL2
- SET VAL2=+$PIECE($GET(^YTT(601.75,VAL2,0)),U,2)
- +7 IF +VAL1<+VAL2
- QUIT 1
- +8 QUIT 0
- +9 ;
- GTI(ID1,ID2) ; returns 1 if ID1 is more than ID2 (integer question)
- +1 ; expects ARGS from VERIFY
- +2 NEW VAL1,VAL2
- +3 ; 1156 = skipped by rule
- SET VAL1=$GET(ARGS(ID1))
- if VAL1="c1156"
- SET VAL1=0
- +4 SET VAL2=$GET(ARGS(ID2))
- if VAL2="c1156"
- SET VAL2=0
- +5 IF +VAL1>+VAL2
- QUIT 1
- +6 QUIT 0
- +7 ;
- MSG(REL,Q1,Q2) ; Add text of message to RESULTS
- +1 ; expects MSGCNT, RESULTS from VERIFY
- +2 NEW X,NOUN
- +3 SET NOUN=$SELECT(Q1="5C":"drinks",1:"days")
- +4 SET X="There is an inconsistency: The number of "
- +5 SET X=X_NOUN_" entered in Question "_Q1
- +6 SET X=X_" should be equal to, or "_REL_" than,"
- +7 SET X=X_" the number of "_NOUN_" in Question "_Q2_"."
- +8 SET MSGCNT=MSGCNT+1
- SET RESULTS("messages",MSGCNT)=X
- +9 QUIT