Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YS119PST

YS119PST.m

Go to the documentation of this file. 
  1. YS119PST ;SLC/KCM - Patch 119 post-init - PCL-5 ; 9/15/2015
  1.  ;;5.01;MENTAL HEALTH;**119**;Dec 30, 1994;Build 40
  1.  Q
  1.  ;
  1. POST ; Post-init calls for patch 119
  1.  D PCL5
  1.  D FIXTESTS^YS119PS0
  1.  Q
  1. PCL5 ; Update the PCL-5 definitions
  1.  D FIXDATE^YS119PS3 ; update the date prompt
  1.  D UPDPCLQ  ; update the PCL-5 questions
  1.  D UPDCPLX  ; update tests that are scored by DLL only
  1.  D DROPPCL  ; disable the PCL tests replaced by PCL-5
  1.  D ADDSCLS  ; add scales for cluster B-E scores
  1.  D UPDPCLR  ; update PCL-5 report
  1.  N TSTIEN   ; make sure definition reloaded by clients 
  1.  S TSTIEN=$$FINDTEST^YS119PS0("PCL-5")
  1.  D UPDDT^YS119PS0(TSTIEN)
  1.  Q
  1. UPDPCLQ ; Update the PCL-5 questions
  1.  N QUES,PCL5,CONTENT,DESIG,QIEN,X0
  1.  ; set up the replacement questions
  1.  S QUES("10.")=$P($T(Q10),";;",2,99)
  1.  S QUES("14.")=$P($T(Q14),";;",2,99)
  1.  S QUES("15.")=$P($T(Q15),";;",2,99)
  1.  S QUES("16.")=$P($T(Q16),";;",2,99)
  1.  ; get the ien for PCL-5
  1.  S PCL5=$O(^YTT(601.71,"B","PCL-5",0))
  1.  ; loop through PCL-5 content, find the questions with matching "designator"
  1.  S CONTENT=0 F  S CONTENT=$O(^YTT(601.76,"AC",PCL5,CONTENT)) Q:'CONTENT  D
  1.  . S X0=^YTT(601.76,CONTENT,0),DESIG=$P(X0,U,5)
  1.  . Q:'$L(DESIG)        ; no designator
  1.  . Q:'$D(QUES(DESIG))  ; no matching replacement
  1.  . S QIEN=$P(X0,U,4)
  1.  . ;
  1.  . N WP,DIERR
  1.  . S WP(1)=QUES(DESIG)
  1.  . D WP^DIE(601.72,QIEN_",",1,"","WP")
  1.  . I $D(DIERR) D BMES^XPDUTL("ERROR: "_$G(^TMP("DIERR",$J,1,"TEXT",1)))
  1.  . D CLEAN^DILF
  1.  Q
  1.  ;
  1. UPDCPLX ; Update complex (DLL-scored) test entries
  1.  N IDX,TSTNM,TSTIEN
  1.  S IDX=0 F  S IDX=IDX+1,TSTNM=$P($T(DLLTEST+IDX),";;",2) Q:TSTNM="zzzzz"  D
  1.  . S TSTIEN=$O(^YTT(601.71,"B",TSTNM,0)) Q:'TSTIEN
  1.  . D FLD2DLL(TSTIEN) ; update TAG and ROUTINE for special scoring
  1.  Q
  1. FLD2DLL(TSTIEN) ; update record to contain DLL^YTSCORE
  1.  N FDA,DIERR
  1.  S FDA(601.71,TSTIEN_",",91)="DLL"
  1.  S FDA(601.71,TSTIEN_",",92)="YTSCORE"
  1.  D FILE^DIE("","FDA")
  1.  I $D(DIERR) D BMES^XPDUTL("ERROR: "_$G(^TMP("DIERR",$J,1,"TEXT",1)))
  1.  D CLEAN^DILF
  1.  Q
  1. DROPPCL ; Disable the other PCL tests
  1.  N TSTNM,TSTIEN
  1.  F TSTNM="PCLC","PCLM","PCLS","NEOPI" D
  1.  . S TSTIEN=$O(^YTT(601.71,"B",TSTNM,0)) Q:'TSTIEN
  1.  . D FLD2DROP(TSTIEN) ; change OPERATIONAL to "Dropped"
  1.  . D UPDDT^YS119PS0(TSTIEN)
  1.  Q
  1. FLD2DROP(TSTIEN) ; update OPERATIONAL field to be "Dropped"
  1.  N FDA,DIERR
  1.  S FDA(601.71,TSTIEN_",",10)="D"
  1.  D FILE^DIE("","FDA")
  1.  I $D(DIERR) D MES^XPDUTL("ERROR: "_$G(^TMP("DIERR",$J,1,"TEXT",1)))
  1.  D CLEAN^DILF
  1.  Q
  1. ADDSCLS ; add scales for PCL-5
  1.  N PCL5,GRP,SCALE,KEYID
  1.  S KEYID=9725
  1.  S PCL5=$O(^YTT(601.71,"B","PCL-5",0))  ; PCL-5 ien
  1.  S GRP=$O(^YTT(601.86,"AC",PCL5,1,0))   ; ScaleGroup, Sequence 1 ien
  1.  D ADDSCALE(.SCALE,990,GRP,2,"Cluster B") I SCALE D ADDKEYS(SCALE,1,5)
  1.  D ADDSCALE(.SCALE,991,GRP,3,"Cluster C") I SCALE D ADDKEYS(SCALE,6,7)
  1.  D ADDSCALE(.SCALE,992,GRP,4,"Cluster D") I SCALE D ADDKEYS(SCALE,8,14)
  1.  D ADDSCALE(.SCALE,993,GRP,5,"Cluster E") I SCALE D ADDKEYS(SCALE,15,20)
  1.  Q
  1. ADDSCALE(SCALE,ID,GRP,SEQ,NM) ; add a new scale
  1.  I $D(^YTT(601.87,"AC",GRP,SEQ)) D  Q  ; quit if scale already there
  1.  . S SCALE=$O(^YTT(601.87,"AC",GRP,SEQ,0))
  1.  ; if something already at ID, increment ID until empty node is found
  1.  I $D(^YTT(601.87,ID)) F  S ID=ID+1 Q:'$D(^YTT(601.87,ID))
  1.  ; use FM to add the new scale (PCL-5 Cluster x)
  1.  N FDA,FDAIEN,DIERR
  1.  S FDAIEN(1)=ID
  1.  S FDA(601.87,"+1,",.01)=ID
  1.  S FDA(601.87,"+1,",1)=GRP
  1.  S FDA(601.87,"+1,",2)=SEQ
  1.  S FDA(601.87,"+1,",3)=NM
  1.  S FDA(601.87,"+1,",4)=NM
  1.  D UPDATE^DIE("","FDA","FDAIEN")
  1.  I $D(DIERR) D MES^XPDUTL("ERROR: "_$G(^TMP("DIERR",$J,1,"TEXT",1)))
  1.  S SCALE=$S($D(DIERR):0,1:FDAIEN(1))
  1.  D CLEAN^DILF
  1.  Q
  1. ADDKEYS(SCALE,FIRST,LAST) ; Add a set of scoring keys for PCL-5
  1.  ; from: ADDSLCS expects: PCL5,KEYID
  1.  N VALUES,VALUE,QNUM,QIEN,CIEN,X0,DESIG
  1.  S VALUES(0)="Not at all"
  1.  S VALUES(1)="A little bit"
  1.  S VALUES(2)="Moderately"
  1.  S VALUES(3)="Quite a bit"
  1.  S VALUES(4)="Extremely"
  1.  F QNUM=FIRST:1:LAST D
  1.  . ; using designator, figure out the IEN for the question
  1.  . S QIEN=0  ; QIEN=question IEN, CIEN=content IEN
  1.  . S CIEN=0 F  S CIEN=$O(^YTT(601.76,"AC",PCL5,CIEN)) Q:'CIEN  D  Q:QIEN
  1.  . . S X0=^YTT(601.76,CIEN,0),DESIG=$P(X0,U,5)
  1.  . . I DESIG=(QNUM_".") S QIEN=$P(X0,U,4)
  1.  . ; for the question (QIEN), add the 5 scoring keys for this scale
  1.  . F VALUE=0:1:4 S KEYID=KEYID+1 D ADDKEY(KEYID,SCALE,QIEN,VALUES(VALUE),VALUE)
  1.  Q
  1. ADDKEY(ID,SCALE,QUESTION,TARGET,VALUE) ; add a new scoring key
  1.  ; quit if key already there
  1.  N EXISTS,I
  1.  S EXISTS=0
  1.  S I=0 F  S I=$O(^YTT(601.91,"AC",SCALE,I)) Q:'I  D  Q:EXISTS
  1.  . I ($P(^YTT(601.91,I,0),U,3))=QUESTION,($P(^(0),U,4)=TARGET) S EXISTS=1
  1.  Q:EXISTS
  1.  ; if something already at ID, increment ID until empty node is found
  1.  I $D(^YTT(601.91,ID)) F  S ID=ID+1 Q:'$D(^YTT(601.91,ID))
  1.  ; use FM to add new key
  1.  N FDA,FDAIEN,DIERR
  1.  S FDAIEN(1)=ID
  1.  S FDA(601.91,"+1,",.01)=ID
  1.  S FDA(601.91,"+1,",1)=SCALE
  1.  S FDA(601.91,"+1,",2)=QUESTION
  1.  S FDA(601.91,"+1,",3)=TARGET
  1.  S FDA(601.91,"+1,",4)=VALUE
  1.  D UPDATE^DIE("","FDA","FDAIEN")
  1.  I $D(DIERR) D MES^XPDUTL("ERROR: "_$G(^TMP("DIERR",$J,1,"TEXT",1)))
  1.  D CLEAN^DILF
  1.  Q
  1. UPDPCLR ; update the PCL-5 report to include cluster information
  1.  N PCL5,RPT,WP,I,X,DIERR
  1.  S PCL5=$O(^YTT(601.71,"B","PCL-5",0))     ; PCL-5 ien
  1.  S RPT=$O(^YTT(601.93,"C",PCL5,0)) Q:'RPT  ; Report ien
  1.  F I=1:1 S X=$P($T(RPTFMT+I),";;",2,99) Q:X="zzzzz"  S WP(I)=X
  1.  D WP^DIE(601.93,RPT_",",2,"","WP")
  1.  I $D(DIERR) D MES^XPDUTL("ERROR: "_$G(^TMP("DIERR",$J,1,"TEXT",1)))
  1.  D CLEAN^DILF
  1.  Q
  1. DLLTEST ; tests scored by DLL
  1.  ;;BAM-C
  1.  ;;BAM-R
  1.  ;;BASIS-24
  1.  ;;BHS
  1.  ;;BSI
  1.  ;;BSL-23
  1.  ;;CAM
  1.  ;;CDR
  1.  ;;DBAS
  1.  ;;DERS
  1.  ;;FAD
  1.  ;;FAST
  1.  ;;ISMI
  1.  ;;MDQ
  1.  ;;MINICOG
  1.  ;;MMPI-2-RF
  1.  ;;NEO-PI-3
  1.  ;;POQ
  1.  ;;QOLI
  1.  ;;QOLIE-31
  1.  ;;SBR II
  1.  ;;SOCRATES 8A
  1.  ;;SOCRATES 8D
  1.  ;;SST-VOF
  1.  ;;SST-VOI
  1.  ;;STMS
  1.  ;;VR-12
  1.  ;;WHODAS 2
  1.  ;;WHOQOL-BREF
  1.  ;;WHYMPI
  1.  ;;zzzzz
  1.  ;
  1. Q10 ;;Blaming yourself or someone else for the stressful experience or what happened after it?
  1. Q14 ;;Trouble experiencing positive feelings (for example, being unable to feel happiness or have loving feelings for people close to you)?
  1. Q15 ;;Irritable behavior, angry outbursts, or acting aggressively?
  1. Q16 ;;Taking too many risks or doing things that could cause you harm?
  1.  ;
  1. RPTFMT ; PCL-5 report text
  1.  ;;.| PCL-5| | Date Given: <.Date_Given.>| Clinician: <.Staff_Ordered_By.>| Location: <.Location.>| | Veteran: <.Patient_Name_Last_First.>| SSN: <.Patient_SSN.>| DOB: <.Patient_Date_Of_Birth.>
  1.  ;;(<.Patient_Age.>)| Gender: <.Patient_Gender.>| | |             PCL-5 Score:  <-PCL-5->| | Cluster B (items  1-5) :  <-Cluster B->| Cluster C (items  6-7) :  <-Cluster C->| Cluster D (items  8-14):
  1.  ;;  <-Cluster D->| Cluster E (items 15-20):  <-Cluster E->| |
  1.  ;;| Interpretive Statement:| PCL-5 has a total score range of 0-80, with higher scores indicating greater PTSD symptom severity.| |
  1.  ;;  0-10:  no or minimal symptoms reported| 11-20:  mild symptoms reported| 21-40:  moderate symptoms reported| 41-60:  severe symptoms reported| 61-80:  very severe symptoms reported|
  1.  ;; | | Questions and Answers: | | The event you experienced was: <*Answer_6839*>| | The event happened: <*Answer_6840*>| |  1. 
  1.  ;;Repeated, disturbing, and unwanted memories of the stressful experience?|     <*Answer_6841*>|  2. Repeated, disturbing dreams of the stressful experience?|     <*Answer_6842*>|  3. Suddenly feeling or
  1.  ;; acting as if the stressful experience were actually happening again (as if you were actually back there reliving it)?|     <*Answer_6843*>|  4. Feeling very upset when something reminded you of the
  1.  ;; stressful experience?|     <*Answer_6844*>|  5. Having strong physical reactions when something reminded you of the stressful experience (for example, heart pounding, trouble breathing, sweating)?|
  1.  ;;     <*Answer_6845*>|  6. Avoiding memories, thoughts, or feelings related to the stressful experience?|     <*Answer_6846*>|  7. Avoiding external reminders of the stressful experience (for example,
  1.  ;; people, places, conversations, activities, objects, or situations)?|     <*Answer_6847*>|  8. Trouble remembering important parts of the stressful experience?|     <*Answer_6848*>|  9. Having strong
  1.  ;; negative beliefs about yourself, other people, or the world (for example, having thoughts such as: I am bad, there is something seriously wrong with me, no one can be trusted, the world is
  1.  ;; completely dangerous)?|     <*Answer_6849*>| 10. Blaming yourself or someone else for the stressful experience or what happened after it?|     <*Answer_6850*>| 11. Having strong negative
  1.  ;; feelings such as fear, horror, anger, guilt, or shame?|     <*Answer_6851*>| 12. Loss of interest in activities that you used to enjoy?|     <*Answer_6852*>| 13. Feeling distant or cut off from other
  1.  ;; people?|     <*Answer_6853*>| 14. Trouble experiencing positive feelings (for example, being unable to feel happiness or have loving feelings for people close to you)?|     
  1.  ;;<*Answer_6854*>| 15. Irritable behavior, angry outbursts, or acting aggressively?|     <*Answer_6855*>| 16. Taking too many risks or doing things that could cause you harm?|     <*Answer_6856*>| 17. Being
  1.  ;; "superalert" or watchful or on guard?|     <*Answer_6857*>| 18. Feeling jumpy or easily startled?|     <*Answer_6858*>| 19. Having difficulty concentrating?|     <*Answer_6859*>| 20. Trouble falling
  1.  ;; or staying asleep?|     <*Answer_6860*>
  1.  ;;| | 0=not at all  1=a little bit  2=moderately  3=quite a bit  4=extremely
  1.  ;;| | Information contained in this note is based on a self-report assessment and is not sufficient to use alone for diagnostic purposes.  Assessment results
  1.  ;; should be verified for accuracy and used in conjunction with other diagnostic activities and procedures.|  $~
  1.  ;;zzzzz