- YTSBAMCC ;SLC/PIJ/KCM - Score BAM-C-CPT-SUD ; 01/08/2016
- ;;5.01;MENTAL HEALTH;**234**;DEC 30,1994;Build 38
- ;
- Q
- ;
- DATA1 ; display scores for administration
- N ANS
- S YSINSNAM=$P($G(YSDATA(2)),U,3)
- I $G(YSINSNAM)="" S YSINSNAM=$G(YS("CODE"),"NO NAME PASSED")
- S NODE=2 F S NODE=$O(YSDATA(NODE)) Q:NODE="" D ; Start at YSDATA(3)
- .S DATA=YSDATA(NODE)
- .S YSQN=$P(DATA,U,1)
- .S ANS=$P(DATA,U,3),ANS=$S(ANS=1155:0,ANS=1156:0,1:ANS)
- .I YSQN=9094 S ALCO=ANS
- .I YSQN=9095 S HALCO=ANS
- .I YSQN=9096 S DRUG=ANS
- Q
- ;
- SCORESV ;
- I $D(^TMP($J,"YSG",1)),^TMP($J,"YSG",1)="[ERROR]" D Q ;-->out
- .K ^TMP($J,"YSCOR")
- .S ^TMP($J,"YSCOR",1)="[ERROR]"
- .S ^TMP($J,"YSCOR",2)=YSINSNAM_" Scale not found"
- ;
- K ^TMP($J,"YSCOR")
- S ^TMP($J,"YSCOR",1)="[DATA]"
- S ^TMP($J,"YSCOR",2)=$$GET1^DIQ(601.87,1503_",",3,"I")_"="_ALCO
- S ^TMP($J,"YSCOR",3)=$$GET1^DIQ(601.87,1504_",",3,"I")_"="_HALCO
- S ^TMP($J,"YSCOR",4)=$$GET1^DIQ(601.87,1505_",",3,"I")_"="_DRUG
- Q
- ;
- DLLSTR(YSDATA,YS,YSTRNG) ;
- ; YSTRNG = 1 Score Instrument
- ; YSTRNG = 2 get Report Answers and Text
- ;
- N ALCO,DATA,DRUG,HALCO,NODE,YSQN,YSINSNAM
- ;
- I YSTRNG=2 Q ; no special processing or text
- ;
- D DATA1
- D SCORESV
- Q
- ;
- VERIFY(ARGS,RESULTS) ; Add inconsistency messages based on set of answers in ARGS
- N MSGCNT S MSGCNT=0
- I $$NV("q9094") D NVMSG("1")
- I $$NV("q9095") D NVMSG("2")
- I $$LT("q9094","q9095") D MSG("more","1","2")
- I $$NV("q9096") D NVMSG("3")
- I $$NV("q9097") D NVMSG("4A")
- I $$LT("q9096","q9097") D MSG("less","4A","3")
- I $$NV("q9098") D NVMSG("4B")
- I $$LT("q9096","q9098") D MSG("less","4B","3")
- I $$NV("q9099") D NVMSG("4C")
- I $$LT("q9096","q9099") D MSG("less","4C","3")
- I $$NV("q9100") D NVMSG("4D")
- I $$LT("q9096","q9100") D MSG("less","4D","3")
- I $$NV("q9101") D NVMSG("4E")
- I $$LT("q9096","q9101") D MSG("less","4E","3")
- I $$NV("q9102") D NVMSG("4F")
- I $$LT("q9096","q9102") D MSG("less","4F","3")
- I $$NV("q9103") D NVMSG("4G")
- I $$LT("q9096","q9103") D MSG("less","4G","3")
- D ALLSUB
- S RESULTS("count")=MSGCNT
- Q
- LT(ID1,ID2) ; returns 1 if ID1 is less than ID2
- ; expects ARGS from VERIFY
- N VAL1,VAL2 ; 1155=not answered, 1156=skipped by rule
- S VAL1=$G(ARGS(ID1)) S:(VAL1="c1156")!(VAL1="c1155") VAL1=0
- S VAL2=$G(ARGS(ID2)) S:(VAL2="c1156")!(VAL2="c1155") VAL2=0
- I +VAL1<+VAL2 Q 1
- Q 0
- ;
- NV(ID) ; returns 1 if ID had no value (has been skipped)
- ; expects ARGS from VERIFY
- N VAL ; 1155=not answered
- S VAL=$G(ARGS(ID)) I VAL="c1155" Q 1
- Q 0
- ;
- MSG(REL,Q1,Q2) ; Add text of message to RESULTS
- ; expects MSGCNT, RESULTS from VERIFY
- N X
- S X="There is an inconsistency: The number of days entered in Question "_Q1
- S X=X_" should be equal to, or "_REL_" than,"
- S X=X_" the number of days in Question "_Q2_"."
- S MSGCNT=MSGCNT+1,RESULTS("messages",MSGCNT)=X
- Q
- NVMSG(Q1) ; Add message for no value present
- ; expects MSGCNT, RESULTS from VERIFY
- N X
- S X="There is an inconsistency: The number of days entered in Question "_Q1
- S X=X_" should not be blank."
- S MSGCNT=MSGCNT+1,RESULTS("messages",MSGCNT)=X
- Q
- ALLSUB ; compare total of all substances with any substance number
- ; expects ARGS, RESULT from VERIFY
- N SUM,ID,X
- S SUM=0
- F ID="q9097","q9098","q9099","q9100","q9101","q9102","q9103" S SUM=SUM+$G(ARGS(ID))
- I SUM<+$G(ARGS("q9096")) D
- . S X="There is an inconsistency: The addition of all the itemized substances"
- . S X=X_" in questions 4A through 4G should be equal to, or greater than, the"
- . S X=X_" number of days in Question 3."
- . S MSGCNT=MSGCNT+1,RESULTS("messages",MSGCNT)=X
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSBAMCC 3634 printed Feb 18, 2025@23:45:34 Page 2
- YTSBAMCC ;SLC/PIJ/KCM - Score BAM-C-CPT-SUD ; 01/08/2016
- +1 ;;5.01;MENTAL HEALTH;**234**;DEC 30,1994;Build 38
- +2 ;
- +3 QUIT
- +4 ;
- DATA1 ; display scores for administration
- +1 NEW ANS
- +2 SET YSINSNAM=$PIECE($GET(YSDATA(2)),U,3)
- +3 IF $GET(YSINSNAM)=""
- SET YSINSNAM=$GET(YS("CODE"),"NO NAME PASSED")
- +4 ; Start at YSDATA(3)
- SET NODE=2
- FOR
- SET NODE=$ORDER(YSDATA(NODE))
- if NODE=""
- QUIT
- Begin DoDot:1
- +5 SET DATA=YSDATA(NODE)
- +6 SET YSQN=$PIECE(DATA,U,1)
- +7 SET ANS=$PIECE(DATA,U,3)
- SET ANS=$SELECT(ANS=1155:0,ANS=1156:0,1:ANS)
- +8 IF YSQN=9094
- SET ALCO=ANS
- +9 IF YSQN=9095
- SET HALCO=ANS
- +10 IF YSQN=9096
- SET DRUG=ANS
- End DoDot:1
- +11 QUIT
- +12 ;
- SCORESV ;
- +1 ;-->out
- IF $DATA(^TMP($JOB,"YSG",1))
- IF ^TMP($JOB,"YSG",1)="[ERROR]"
- Begin DoDot:1
- +2 KILL ^TMP($JOB,"YSCOR")
- +3 SET ^TMP($JOB,"YSCOR",1)="[ERROR]"
- +4 SET ^TMP($JOB,"YSCOR",2)=YSINSNAM_" Scale not found"
- End DoDot:1
- QUIT
- +5 ;
- +6 KILL ^TMP($JOB,"YSCOR")
- +7 SET ^TMP($JOB,"YSCOR",1)="[DATA]"
- +8 SET ^TMP($JOB,"YSCOR",2)=$$GET1^DIQ(601.87,1503_",",3,"I")_"="_ALCO
- +9 SET ^TMP($JOB,"YSCOR",3)=$$GET1^DIQ(601.87,1504_",",3,"I")_"="_HALCO
- +10 SET ^TMP($JOB,"YSCOR",4)=$$GET1^DIQ(601.87,1505_",",3,"I")_"="_DRUG
- +11 QUIT
- +12 ;
- DLLSTR(YSDATA,YS,YSTRNG) ;
- +1 ; YSTRNG = 1 Score Instrument
- +2 ; YSTRNG = 2 get Report Answers and Text
- +3 ;
- +4 NEW ALCO,DATA,DRUG,HALCO,NODE,YSQN,YSINSNAM
- +5 ;
- +6 ; no special processing or text
- IF YSTRNG=2
- QUIT
- +7 ;
- +8 DO DATA1
- +9 DO SCORESV
- +10 QUIT
- +11 ;
- VERIFY(ARGS,RESULTS) ; Add inconsistency messages based on set of answers in ARGS
- +1 NEW MSGCNT
- SET MSGCNT=0
- +2 IF $$NV("q9094")
- DO NVMSG("1")
- +3 IF $$NV("q9095")
- DO NVMSG("2")
- +4 IF $$LT("q9094","q9095")
- DO MSG("more","1","2")
- +5 IF $$NV("q9096")
- DO NVMSG("3")
- +6 IF $$NV("q9097")
- DO NVMSG("4A")
- +7 IF $$LT("q9096","q9097")
- DO MSG("less","4A","3")
- +8 IF $$NV("q9098")
- DO NVMSG("4B")
- +9 IF $$LT("q9096","q9098")
- DO MSG("less","4B","3")
- +10 IF $$NV("q9099")
- DO NVMSG("4C")
- +11 IF $$LT("q9096","q9099")
- DO MSG("less","4C","3")
- +12 IF $$NV("q9100")
- DO NVMSG("4D")
- +13 IF $$LT("q9096","q9100")
- DO MSG("less","4D","3")
- +14 IF $$NV("q9101")
- DO NVMSG("4E")
- +15 IF $$LT("q9096","q9101")
- DO MSG("less","4E","3")
- +16 IF $$NV("q9102")
- DO NVMSG("4F")
- +17 IF $$LT("q9096","q9102")
- DO MSG("less","4F","3")
- +18 IF $$NV("q9103")
- DO NVMSG("4G")
- +19 IF $$LT("q9096","q9103")
- DO MSG("less","4G","3")
- +20 DO ALLSUB
- +21 SET RESULTS("count")=MSGCNT
- +22 QUIT
- LT(ID1,ID2) ; returns 1 if ID1 is less than ID2
- +1 ; expects ARGS from VERIFY
- +2 ; 1155=not answered, 1156=skipped by rule
- NEW VAL1,VAL2
- +3 SET VAL1=$GET(ARGS(ID1))
- if (VAL1="c1156")!(VAL1="c1155")
- SET VAL1=0
- +4 SET VAL2=$GET(ARGS(ID2))
- if (VAL2="c1156")!(VAL2="c1155")
- SET VAL2=0
- +5 IF +VAL1<+VAL2
- QUIT 1
- +6 QUIT 0
- +7 ;
- NV(ID) ; returns 1 if ID had no value (has been skipped)
- +1 ; expects ARGS from VERIFY
- +2 ; 1155=not answered
- NEW VAL
- +3 SET VAL=$GET(ARGS(ID))
- IF VAL="c1155"
- QUIT 1
- +4 QUIT 0
- +5 ;
- MSG(REL,Q1,Q2) ; Add text of message to RESULTS
- +1 ; expects MSGCNT, RESULTS from VERIFY
- +2 NEW X
- +3 SET X="There is an inconsistency: The number of days entered in Question "_Q1
- +4 SET X=X_" should be equal to, or "_REL_" than,"
- +5 SET X=X_" the number of days in Question "_Q2_"."
- +6 SET MSGCNT=MSGCNT+1
- SET RESULTS("messages",MSGCNT)=X
- +7 QUIT
- NVMSG(Q1) ; Add message for no value present
- +1 ; expects MSGCNT, RESULTS from VERIFY
- +2 NEW X
- +3 SET X="There is an inconsistency: The number of days entered in Question "_Q1
- +4 SET X=X_" should not be blank."
- +5 SET MSGCNT=MSGCNT+1
- SET RESULTS("messages",MSGCNT)=X
- +6 QUIT
- ALLSUB ; compare total of all substances with any substance number
- +1 ; expects ARGS, RESULT from VERIFY
- +2 NEW SUM,ID,X
- +3 SET SUM=0
- +4 FOR ID="q9097","q9098","q9099","q9100","q9101","q9102","q9103"
- SET SUM=SUM+$GET(ARGS(ID))
- +5 IF SUM<+$GET(ARGS("q9096"))
- Begin DoDot:1
- +6 SET X="There is an inconsistency: The addition of all the itemized substances"
- +7 SET X=X_" in questions 4A through 4G should be equal to, or greater than, the"
- +8 SET X=X_" number of days in Question 3."
- +9 SET MSGCNT=MSGCNT+1
- SET RESULTS("messages",MSGCNT)=X
- End DoDot:1
- +10 QUIT