- YTSBAMC ;SLC/PIJ - Score BAMC ; 01/08/2016
- ;;5.01;MENTAL HEALTH;**123,130**;DEC 30,1994;Build 62
- ;
- ;Public, Supported ICRs
- ; #2056 - Fileman API - $$GET1^DIQ
- ;
- 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=6464 S ALCO=ANS
- .I YSQN=6465 S HALCO=ANS
- .I YSQN=6466 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,778_",",3,"I")_"="_ALCO
- S ^TMP($J,"YSCOR",3)=$$GET1^DIQ(601.87,838_",",3,"I")_"="_HALCO
- S ^TMP($J,"YSCOR",4)=$$GET1^DIQ(601.87,839_",",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("q6464") D NVMSG("1")
- I $$NV("q6465") D NVMSG("2")
- I $$LT("q6464","q6465") D MSG("more","1","2")
- I $$NV("q6466") D NVMSG("3")
- I $$NV("q6467") D NVMSG("4A")
- I $$LT("q6466","q6467") D MSG("less","4A","3")
- I $$NV("q6468") D NVMSG("4B")
- I $$LT("q6466","q6468") D MSG("less","4B","3")
- I $$NV("q6469") D NVMSG("4C")
- I $$LT("q6466","q6469") D MSG("less","4C","3")
- I $$NV("q6470") D NVMSG("4D")
- I $$LT("q6466","q6470") D MSG("less","4D","3")
- I $$NV("q6471") D NVMSG("4E")
- I $$LT("q6466","q6471") D MSG("less","4E","3")
- I $$NV("q6472") D NVMSG("4F")
- I $$LT("q6466","q6472") D MSG("less","4F","3")
- I $$NV("q6473") D NVMSG("4G")
- I $$LT("q6466","q6473") 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="q6467","q6468","q6469","q6470","q6471","q6472","q6473" S SUM=SUM+$G(ARGS(ID))
- I SUM<+$G(ARGS("q6466")) 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[HYTSBAMC 3688 printed Feb 18, 2025@23:45:33 Page 2
- YTSBAMC ;SLC/PIJ - Score BAMC ; 01/08/2016
- +1 ;;5.01;MENTAL HEALTH;**123,130**;DEC 30,1994;Build 62
- +2 ;
- +3 ;Public, Supported ICRs
- +4 ; #2056 - Fileman API - $$GET1^DIQ
- +5 ;
- +6 QUIT
- +7 ;
- 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=6464
- SET ALCO=ANS
- +9 IF YSQN=6465
- SET HALCO=ANS
- +10 IF YSQN=6466
- 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,778_",",3,"I")_"="_ALCO
- +9 SET ^TMP($JOB,"YSCOR",3)=$$GET1^DIQ(601.87,838_",",3,"I")_"="_HALCO
- +10 SET ^TMP($JOB,"YSCOR",4)=$$GET1^DIQ(601.87,839_",",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("q6464")
- DO NVMSG("1")
- +3 IF $$NV("q6465")
- DO NVMSG("2")
- +4 IF $$LT("q6464","q6465")
- DO MSG("more","1","2")
- +5 IF $$NV("q6466")
- DO NVMSG("3")
- +6 IF $$NV("q6467")
- DO NVMSG("4A")
- +7 IF $$LT("q6466","q6467")
- DO MSG("less","4A","3")
- +8 IF $$NV("q6468")
- DO NVMSG("4B")
- +9 IF $$LT("q6466","q6468")
- DO MSG("less","4B","3")
- +10 IF $$NV("q6469")
- DO NVMSG("4C")
- +11 IF $$LT("q6466","q6469")
- DO MSG("less","4C","3")
- +12 IF $$NV("q6470")
- DO NVMSG("4D")
- +13 IF $$LT("q6466","q6470")
- DO MSG("less","4D","3")
- +14 IF $$NV("q6471")
- DO NVMSG("4E")
- +15 IF $$LT("q6466","q6471")
- DO MSG("less","4E","3")
- +16 IF $$NV("q6472")
- DO NVMSG("4F")
- +17 IF $$LT("q6466","q6472")
- DO MSG("less","4F","3")
- +18 IF $$NV("q6473")
- DO NVMSG("4G")
- +19 IF $$LT("q6466","q6473")
- 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="q6467","q6468","q6469","q6470","q6471","q6472","q6473"
- SET SUM=SUM+$GET(ARGS(ID))
- +5 IF SUM<+$GET(ARGS("q6466"))
- 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