- YTSBAMRC ;SLC/PIJ/KCM - Score BAM-R-CSG-SUD ; 01/08/2016
- ;;5.01;MENTAL HEALTH;**234**;DEC 30,1994;Build 38
- ;
- Q
- ;
- DATA1 ; display scores for administration
- N ANS,LEG,NODE,YSCDA,YSSEQ,YS
- N DATA,DES,SCORE,YSANS,YSQN,CID
- S SCORE=0
- 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 YSSEQ=$P($P(DATA,U,2),";",1) ; Sequence Number
- .;if $P(YSSEQ,";",2)'"" then no Choice ID, piece 3 is data
- .S YSANS=$P($P(DATA,U,2),";",2)
- .S ANS=$P(DATA,U,3),ANS=$S(ANS=1155:0,ANS=1156:0,1:ANS)
- .D DESGNTR^YTSCORE(YSQN,.DES)
- .S YSCDA=$P($G(DATA),U,3) ; Choice ID
- .I $G(YSANS) S LEG=YSCDA
- .; legacy values are not correct for numerous CHOICE ID's, therefore set value from ID
- .I '$G(YSANS) S CID=YSCDA D
- ..S LEG=$S(CID=212:0,CID=1059:0,CID=1060:1,CID=1061:2,CID=1062:3,CID=1063:4,CID=717:1,CID=685:2,CID=2312:3,CID=687:4,CID=241:"Y",1:"")
- .I (DES="A")!(DES="B") Q
- .D SCORE
- Q
- ;
- SCORE ;
- I DES=1 D
- .S HEALTH=HEALTH+LEG
- .S RISK=RISK+$$SCORADJ(LEG)
- I DES=2 D
- .S SLEEP=LEG
- .S RISK=RISK+LEG
- I DES=3 D
- .S DISTR=LEG
- .S RISK=RISK+LEG
- I DES=4 D
- .S DAYSAU=LEG
- .S USE=USE+LEG
- I DES="5A" D
- .S DAYSHA=LEG
- .S USE=USE+LEG
- I DES=6 D
- .S DAYSDRUG=LEG
- .S USE=USE+LEG
- I DES=8 D
- .S URGE=LEG
- .S RISK=RISK+$$SCORADJ(LEG)
- I DES=9 D
- .S CONFID=LEG
- .S PROTECT=PROTECT+$$SCORADJ(LEG)
- I DES=10 D
- .S SELF=LEG
- .S PROTECT=PROTECT+LEG
- I DES=11 D
- .S RISKY=LEG
- .S RISK=RISK+LEG
- I DES=12 D
- .S SPIRIT=LEG
- .S PROTECT=PROTECT+$$SCORADJ(LEG)
- I DES=13 D
- .S WORK=LEG
- .S PROTECT=PROTECT+LEG
- I DES=14 D
- .I LEG="Y" S INCME=4,PROTECT=PROTECT+30
- I DES=15 D
- .S RELAT=LEG
- .S RISK=RISK+$$SCORADJ(LEG)
- I DES=16 D
- .S SUPT=LEG
- .S PROTECT=PROTECT+LEG
- Q
- ;
- SCORADJ(SCOR) ;
- S ANS=0
- I SCOR=1 S ANS=8
- I SCOR=2 S ANS=15
- I SCOR=3 S ANS=22
- I SCOR=4 S ANS=30
- Q ANS
- ;
- 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)="BAM-R-CSG-SUD Scale not found"
- ;
- K ^TMP($J,"YSCOR")
- S ^TMP($J,"YSCOR",1)="[DATA]"
- S ^TMP($J,"YSCOR",2)=$$GET1^DIQ(601.87,1506_",",3,"I")_"="_USE
- S ^TMP($J,"YSCOR",3)=$$GET1^DIQ(601.87,1507_",",3,"I")_"="_RISK
- S ^TMP($J,"YSCOR",4)=$$GET1^DIQ(601.87,1508_",",3,"I")_"="_PROTECT
- S ^TMP($J,"YSCOR",5)=$$GET1^DIQ(601.87,1509_",",3,"I")_"="_DAYSAU
- S ^TMP($J,"YSCOR",6)=$$GET1^DIQ(601.87,1510_",",3,"I")_"="_DAYSHA
- S ^TMP($J,"YSCOR",7)=$$GET1^DIQ(601.87,1511_",",3,"I")_"="_DAYSDRUG
- S ^TMP($J,"YSCOR",8)=$$GET1^DIQ(601.87,1512_",",3,"I")_"="_HEALTH
- S ^TMP($J,"YSCOR",9)=$$GET1^DIQ(601.87,1513_",",3,"I")_"="_SLEEP
- S ^TMP($J,"YSCOR",10)=$$GET1^DIQ(601.87,1514_",",3,"I")_"="_DISTR
- S ^TMP($J,"YSCOR",11)=$$GET1^DIQ(601.87,1515_",",3,"I")_"="_URGE
- S ^TMP($J,"YSCOR",12)=$$GET1^DIQ(601.87,1516_",",3,"I")_"="_RISKY
- S ^TMP($J,"YSCOR",13)=$$GET1^DIQ(601.87,1517_",",3,"I")_"="_RELAT
- S ^TMP($J,"YSCOR",14)=$$GET1^DIQ(601.87,1518_",",3,"I")_"="_CONFID
- S ^TMP($J,"YSCOR",15)=$$GET1^DIQ(601.87,1519_",",3,"I")_"="_SELF
- S ^TMP($J,"YSCOR",16)=$$GET1^DIQ(601.87,1520_",",3,"I")_"="_SPIRIT
- S ^TMP($J,"YSCOR",17)=$$GET1^DIQ(601.87,1521_",",3,"I")_"="_WORK
- S ^TMP($J,"YSCOR",18)=$$GET1^DIQ(601.87,1522_",",3,"I")_"="_INCME
- S ^TMP($J,"YSCOR",19)=$$GET1^DIQ(601.87,1523_",",3,"I")_"="_SUPT
- ;
- Q
- DLLSTR(YSDATA,YS,YSTRNG) ;
- ; YSTRNG = 1 Score Instrument
- ; YSTRNG = 2 get Report Answers and Text
- N YSINSNAM
- N USE,RISK,PROTECT,DAYSAU,DAYSHA,DAYSDRUG,HEALTH,SLEEP
- N DISTR,URGE,RISKY,RELAT,CONFID,SELF,SPIRIT,WORK,INCME,SUPT
- ;
- S (USE,RISK,PROTECT,DAYSAU,DAYSHA,DAYSDRUG,HEALTH,SLEEP)=0
- S (DISTR,URGE,RISKY,RELAT,CONFID,SELF,SPIRIT,WORK,INCME,SUPT)=0
- ;
- I YSTRNG=2 Q ; No special text, computations in the report.
- ;
- D DATA1
- D SCORESV
- Q
- ;
- VERIFY(ARGS,RESULTS) ; Add inconsistency messages based on set of answers in ARGS
- N MSGCNT S MSGCNT=0
- I $$LT("q9115","q9116") D MSG("more","4","5A")
- I $$LT("q9117","q9118") D MSG("less","7A","6")
- I $$LT("q9117","q9119") D MSG("less","7B","6")
- I $$LT("q9117","q9120") D MSG("less","7C","6")
- I $$LT("q9117","q9121") D MSG("less","7D","6")
- I $$LT("q9117","q9122") D MSG("less","7E","6")
- I $$LT("q9117","q9123") D MSG("less","7F","6")
- I $$LT("q9117","q9124") D MSG("less","7G","6")
- I $$GT("q9129","q9130") 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=$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
- ;
- GT(ID1,ID2) ; returns 1 if ID1 is more than ID2
- ; 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[HYTSBAMRC 5385 printed Feb 18, 2025@23:45:38 Page 2
- YTSBAMRC ;SLC/PIJ/KCM - Score BAM-R-CSG-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,LEG,NODE,YSCDA,YSSEQ,YS
- +2 NEW DATA,DES,SCORE,YSANS,YSQN,CID
- +3 SET SCORE=0
- +4 SET YSINSNAM=$PIECE($GET(YSDATA(2)),U,3)
- +5 IF $GET(YSINSNAM)=""
- SET YSINSNAM=$GET(YS("CODE"),"NO NAME PASSED")
- +6 ; Start at YSDATA(3)
- SET NODE=2
- FOR
- SET NODE=$ORDER(YSDATA(NODE))
- if NODE=""
- QUIT
- Begin DoDot:1
- +7 SET DATA=YSDATA(NODE)
- +8 SET YSQN=$PIECE(DATA,U,1)
- +9 ; Sequence Number
- SET YSSEQ=$PIECE($PIECE(DATA,U,2),";",1)
- +10 ;if $P(YSSEQ,";",2)'"" then no Choice ID, piece 3 is data
- +11 SET YSANS=$PIECE($PIECE(DATA,U,2),";",2)
- +12 SET ANS=$PIECE(DATA,U,3)
- SET ANS=$SELECT(ANS=1155:0,ANS=1156:0,1:ANS)
- +13 DO DESGNTR^YTSCORE(YSQN,.DES)
- +14 ; Choice ID
- SET YSCDA=$PIECE($GET(DATA),U,3)
- +15 IF $GET(YSANS)
- SET LEG=YSCDA
- +16 ; legacy values are not correct for numerous CHOICE ID's, therefore set value from ID
- +17 IF '$GET(YSANS)
- SET CID=YSCDA
- Begin DoDot:2
- +18 SET LEG=$SELECT(CID=212:0,CID=1059:0,CID=1060:1,CID=1061:2,CID=1062:3,CID=1063:4,CID=717:1,CID=685:2,CID=2312:3,CID=687:4,CID=241:"Y",1:"")
- End DoDot:2
- +19 IF (DES="A")!(DES="B")
- QUIT
- +20 DO SCORE
- End DoDot:1
- +21 QUIT
- +22 ;
- SCORE ;
- +1 IF DES=1
- Begin DoDot:1
- +2 SET HEALTH=HEALTH+LEG
- +3 SET RISK=RISK+$$SCORADJ(LEG)
- End DoDot:1
- +4 IF DES=2
- Begin DoDot:1
- +5 SET SLEEP=LEG
- +6 SET RISK=RISK+LEG
- End DoDot:1
- +7 IF DES=3
- Begin DoDot:1
- +8 SET DISTR=LEG
- +9 SET RISK=RISK+LEG
- End DoDot:1
- +10 IF DES=4
- Begin DoDot:1
- +11 SET DAYSAU=LEG
- +12 SET USE=USE+LEG
- End DoDot:1
- +13 IF DES="5A"
- Begin DoDot:1
- +14 SET DAYSHA=LEG
- +15 SET USE=USE+LEG
- End DoDot:1
- +16 IF DES=6
- Begin DoDot:1
- +17 SET DAYSDRUG=LEG
- +18 SET USE=USE+LEG
- End DoDot:1
- +19 IF DES=8
- Begin DoDot:1
- +20 SET URGE=LEG
- +21 SET RISK=RISK+$$SCORADJ(LEG)
- End DoDot:1
- +22 IF DES=9
- Begin DoDot:1
- +23 SET CONFID=LEG
- +24 SET PROTECT=PROTECT+$$SCORADJ(LEG)
- End DoDot:1
- +25 IF DES=10
- Begin DoDot:1
- +26 SET SELF=LEG
- +27 SET PROTECT=PROTECT+LEG
- End DoDot:1
- +28 IF DES=11
- Begin DoDot:1
- +29 SET RISKY=LEG
- +30 SET RISK=RISK+LEG
- End DoDot:1
- +31 IF DES=12
- Begin DoDot:1
- +32 SET SPIRIT=LEG
- +33 SET PROTECT=PROTECT+$$SCORADJ(LEG)
- End DoDot:1
- +34 IF DES=13
- Begin DoDot:1
- +35 SET WORK=LEG
- +36 SET PROTECT=PROTECT+LEG
- End DoDot:1
- +37 IF DES=14
- Begin DoDot:1
- +38 IF LEG="Y"
- SET INCME=4
- SET PROTECT=PROTECT+30
- End DoDot:1
- +39 IF DES=15
- Begin DoDot:1
- +40 SET RELAT=LEG
- +41 SET RISK=RISK+$$SCORADJ(LEG)
- End DoDot:1
- +42 IF DES=16
- Begin DoDot:1
- +43 SET SUPT=LEG
- +44 SET PROTECT=PROTECT+LEG
- End DoDot:1
- +45 QUIT
- +46 ;
- SCORADJ(SCOR) ;
- +1 SET ANS=0
- +2 IF SCOR=1
- SET ANS=8
- +3 IF SCOR=2
- SET ANS=15
- +4 IF SCOR=3
- SET ANS=22
- +5 IF SCOR=4
- SET ANS=30
- +6 QUIT ANS
- +7 ;
- 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)="BAM-R-CSG-SUD 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,1506_",",3,"I")_"="_USE
- +9 SET ^TMP($JOB,"YSCOR",3)=$$GET1^DIQ(601.87,1507_",",3,"I")_"="_RISK
- +10 SET ^TMP($JOB,"YSCOR",4)=$$GET1^DIQ(601.87,1508_",",3,"I")_"="_PROTECT
- +11 SET ^TMP($JOB,"YSCOR",5)=$$GET1^DIQ(601.87,1509_",",3,"I")_"="_DAYSAU
- +12 SET ^TMP($JOB,"YSCOR",6)=$$GET1^DIQ(601.87,1510_",",3,"I")_"="_DAYSHA
- +13 SET ^TMP($JOB,"YSCOR",7)=$$GET1^DIQ(601.87,1511_",",3,"I")_"="_DAYSDRUG
- +14 SET ^TMP($JOB,"YSCOR",8)=$$GET1^DIQ(601.87,1512_",",3,"I")_"="_HEALTH
- +15 SET ^TMP($JOB,"YSCOR",9)=$$GET1^DIQ(601.87,1513_",",3,"I")_"="_SLEEP
- +16 SET ^TMP($JOB,"YSCOR",10)=$$GET1^DIQ(601.87,1514_",",3,"I")_"="_DISTR
- +17 SET ^TMP($JOB,"YSCOR",11)=$$GET1^DIQ(601.87,1515_",",3,"I")_"="_URGE
- +18 SET ^TMP($JOB,"YSCOR",12)=$$GET1^DIQ(601.87,1516_",",3,"I")_"="_RISKY
- +19 SET ^TMP($JOB,"YSCOR",13)=$$GET1^DIQ(601.87,1517_",",3,"I")_"="_RELAT
- +20 SET ^TMP($JOB,"YSCOR",14)=$$GET1^DIQ(601.87,1518_",",3,"I")_"="_CONFID
- +21 SET ^TMP($JOB,"YSCOR",15)=$$GET1^DIQ(601.87,1519_",",3,"I")_"="_SELF
- +22 SET ^TMP($JOB,"YSCOR",16)=$$GET1^DIQ(601.87,1520_",",3,"I")_"="_SPIRIT
- +23 SET ^TMP($JOB,"YSCOR",17)=$$GET1^DIQ(601.87,1521_",",3,"I")_"="_WORK
- +24 SET ^TMP($JOB,"YSCOR",18)=$$GET1^DIQ(601.87,1522_",",3,"I")_"="_INCME
- +25 SET ^TMP($JOB,"YSCOR",19)=$$GET1^DIQ(601.87,1523_",",3,"I")_"="_SUPT
- +26 ;
- +27 QUIT
- DLLSTR(YSDATA,YS,YSTRNG) ;
- +1 ; YSTRNG = 1 Score Instrument
- +2 ; YSTRNG = 2 get Report Answers and Text
- +3 NEW YSINSNAM
- +4 NEW USE,RISK,PROTECT,DAYSAU,DAYSHA,DAYSDRUG,HEALTH,SLEEP
- +5 NEW DISTR,URGE,RISKY,RELAT,CONFID,SELF,SPIRIT,WORK,INCME,SUPT
- +6 ;
- +7 SET (USE,RISK,PROTECT,DAYSAU,DAYSHA,DAYSDRUG,HEALTH,SLEEP)=0
- +8 SET (DISTR,URGE,RISKY,RELAT,CONFID,SELF,SPIRIT,WORK,INCME,SUPT)=0
- +9 ;
- +10 ; No special text, computations in the report.
- IF YSTRNG=2
- QUIT
- +11 ;
- +12 DO DATA1
- +13 DO SCORESV
- +14 QUIT
- +15 ;
- VERIFY(ARGS,RESULTS) ; Add inconsistency messages based on set of answers in ARGS
- +1 NEW MSGCNT
- SET MSGCNT=0
- +2 IF $$LT("q9115","q9116")
- DO MSG("more","4","5A")
- +3 IF $$LT("q9117","q9118")
- DO MSG("less","7A","6")
- +4 IF $$LT("q9117","q9119")
- DO MSG("less","7B","6")
- +5 IF $$LT("q9117","q9120")
- DO MSG("less","7C","6")
- +6 IF $$LT("q9117","q9121")
- DO MSG("less","7D","6")
- +7 IF $$LT("q9117","q9122")
- DO MSG("less","7E","6")
- +8 IF $$LT("q9117","q9123")
- DO MSG("less","7F","6")
- +9 IF $$LT("q9117","q9124")
- DO MSG("less","7G","6")
- +10 IF $$GT("q9129","q9130")
- 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=$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 ;
- GT(ID1,ID2) ; returns 1 if ID1 is more than ID2
- +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