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

BTIUSTSC.m

Go to the documentation of this file. 
  1. BTIUSTSC ; IHS/MSC/JS - V STROKE SCALE OBJECT ;17-Nov-2014 15:54;DU
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**1012,1013**;MAR 20, 2013;Build 33
  1.  ;
  1.  Q
  1.  ;
  1. STSCALE(DFN,TARGET,VIEN,STCNT) ; EHR p12
  1.  ; -- get patient visit --
  1.  NEW VST
  1.  S STCNT=$G(STCNT)
  1.  I $G(VIEN)'="" G SCALE
  1.  S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
  1.  I VST="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
  1.  I VST<1 Q " "
  1.  S VIEN=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1 S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
  1.  ;S VIEN=$P(VST,";",4)
  1.  I $G(VIEN)="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
  1.  ;
  1. SCALE ; -- check V STROKE file #9000010.63 for NIH records and not EIE --
  1.  NEW STRIEN,CNT,FNUM,VSTRARR,VSTRERR
  1.  S STRIEN=""
  1.  S CNT=0
  1.  F  S STRIEN=$O(^AUPNVSTR("AD",VIEN,STRIEN)) Q:STRIEN=""  D
  1.  .I '$D(^AUPNVSTR(STRIEN)) Q  ; broken record
  1.  .I '$D(^AUPNVSTR(STRIEN,15)) Q  ; NIH not filed
  1.  .I $P($G(^AUPNVSTR(STRIEN,5)),U,1) Q  ; EIE
  1.  .D GETS
  1.  Q "~@"_$NA(@TARGET)
  1.  ;
  1. GETS ; -- check/retrieve file entry --
  1.  S FNUM=$$FNUM
  1.  I FNUM=0 S @TARGET@(1,0)="Server error: "_$G(FILERR("DIERR",1))_U_$G(FILERR("DIERR",1,"TEXT",1)) K FILERR Q "~@"_$NA(@TARGET)
  1.  ;K @TARGET  <<<<<<<<<<<<<<<<<<<<  10/11/13
  1.  K VSTRARR,VSTRERR
  1.  D GETS^DIQ(FNUM,STRIEN_",","**","IE","VSTRARR","VSTRERR") ;  retrieve file entry data
  1.  I $D(VSTRERR) D   Q "~@"_$NA(@TARGET)
  1.  .S @TARGET@(1,0)="Server error: "_$G(VSTRERR("DIERR",1))_U_$G(VSTRERR("DIERR",1,"TEXT",1))
  1.  ;
  1.  NEW WT
  1.  D WEIGHT(VIEN)
  1.  ;
  1.  D PRINT(STRIEN,.STCNT)
  1.  I CNT=0 S @TARGET@(1,0)="No V STROKE entry for patient visit"
  1.  Q
  1.  ; -- print the V Stroke entry data --
  1. PRINT(STRIEN,STCNT) ;
  1.  NEW SPACE,ARRIVED,PATNAME,HANDED,FIBINIT,VCNT,FIBNOT
  1.  S $P(SPACE," ",1)=""
  1.  S ARRIVED=$G(VSTRARR(FNUM,STRIEN_",",".01","E")) ;.01       ARRIVAL DATE/TIME (RD), [0;1]
  1.  S PATNAME=$G(VSTRARR(FNUM,STRIEN_",",".02","E")) ;.02       PATIENT NAME (RP9000001'I), [0;2]
  1.  S HANDED=$G(VSTRARR(FNUM,STRIEN_",",".04","E")) ; .04       HANDEDNESS (F), [0;4]
  1.  S FIBINIT=$G(VSTRARR(FNUM,STRIEN_",",".11","E")) ;.11       FIBRINOLYTIC THERAPY INITIATED (D), [0;11]
  1.  S FIBNOT=$G(VSTRARR(FNUM,STRIEN_",",".14","E"))  ;.14       FIBRINOLYTIC THERAPY NOT INITIATED
  1.  S CNT=CNT+1
  1.  S @TARGET@(CNT,0)="--- NIH Stroke Score(s) ---"
  1.  S CNT=CNT+1
  1.  I FIBINIT'="" S @TARGET@(CNT,0)="Fibrinolytic therapy started at: "_$G(FIBINIT)
  1.  I FIBNOT'="" S @TARGET@(CNT,0)="Fibrinolytic therapy not intiated at: "_$G(FIBNOT)
  1.  S CNT=CNT+1
  1.  S @TARGET@(CNT,0)="Handedness: "_$G(HANDED)
  1.  S CNT=CNT+1
  1.  S @TARGET@(CNT,0)="Weight:     "_$G(WT)
  1.  S CNT=CNT+1
  1.  S @TARGET@(CNT,0)=SPACE
  1.  D NIH
  1.  Q
  1.  ;
  1.  ;NIH STROKE SCALE #9000010.6315 -- NIH STROKE SCALE SUB-FILE FIELD #1500
  1. NIH ;
  1.  NEW STRING,NODE,STIME,SSTIME,SPACE,QUIT,BY
  1.  S QUIT=0
  1.  S STRING="",NODE=""
  1.  S $P(SPACE," ",1)=""
  1.  F  S NODE=$O(VSTRARR(9000010.6315,NODE)) Q:'+NODE!(QUIT=1)  D
  1.  . I STCNT'="" S STCNT=STCNT-1 I STCNT=0 S QUIT=1
  1.  . S STIME=$G(VSTRARR(9000010.6315,NODE,".02","E")) ;  >>>  .02  EVENT DATE/TIME (D), [0;2]
  1.  . S BY=$G(VSTRARR(9000010.6315,NODE,".03","E"))
  1.  . S CNT=CNT+1
  1.  . S @TARGET@(CNT,0)=""
  1.  . S @TARGET@(CNT,0)="NIH Stroke Score at: "_STIME_" by "_BY
  1.  . S STRING=$G(VSTRARR(9000010.6315,NODE,".04","E"))
  1.  . S CNT=CNT+1
  1.  . S @TARGET@(CNT,0)="     Level of Consciousness: "_$G(STRING)
  1.  . S STRING=$G(VSTRARR(9000010.6315,NODE,".05","E"))
  1.  . S CNT=CNT+1
  1.  . S @TARGET@(CNT,0)="              LOC Questions: "_$G(STRING)
  1.  . S STRING=$G(VSTRARR(9000010.6315,NODE,".06","E"))
  1.  . S CNT=CNT+1
  1.  . S @TARGET@(CNT,0)="               LOC Commands: "_$G(STRING)
  1.  . S STRING=$G(VSTRARR(9000010.6315,NODE,".07","E"))
  1.  . S CNT=CNT+1
  1.  . S @TARGET@(CNT,0)="                2 Best Gaze: "_$G(STRING)
  1.  . S STRING=$G(VSTRARR(9000010.6315,NODE,".08","E"))
  1.  . S CNT=CNT+1
  1.  . S @TARGET@(CNT,0)="                     Visual: "_$G(STRING)
  1.  . S STRING=$G(VSTRARR(9000010.6315,NODE,".09","E"))
  1.  . S CNT=CNT+1
  1.  . S @TARGET@(CNT,0)="               Facial Palsy: "_$G(STRING)
  1.  . S STRING=$G(VSTRARR(9000010.6315,NODE,".1","E"))
  1.  . S CNT=CNT+1
  1.  . S @TARGET@(CNT,0)="             Motor Arm Left: "_$G(STRING)
  1.  . S STRING=$G(VSTRARR(9000010.6315,NODE,".11","E"))
  1.  . S CNT=CNT+1
  1.  . S @TARGET@(CNT,0)="            Motor Arm Right: "_$G(STRING)
  1.  . S STRING=$G(VSTRARR(9000010.6315,NODE,".12","E"))
  1.  . S CNT=CNT+1
  1.  . S @TARGET@(CNT,0)="             Motor Left Leg: "_$G(STRING)
  1.  . S STRING=$G(VSTRARR(9000010.6315,NODE,".13","E"))
  1.  . S CNT=CNT+1
  1.  . S @TARGET@(CNT,0)="            Motor Right Leg: "_$G(STRING)
  1.  . S STRING=$G(VSTRARR(9000010.6315,NODE,".14","E"))
  1.  . S CNT=CNT+1
  1.  . S @TARGET@(CNT,0)="                Limb Ataxia: "_$G(STRING)
  1.  . S STRING=$G(VSTRARR(9000010.6315,NODE,".15","E"))
  1.  . S CNT=CNT+1
  1.  . S @TARGET@(CNT,0)="                    Sensory: "_$G(STRING)
  1.  . S STRING=$G(VSTRARR(9000010.6315,NODE,".16","E"))
  1.  . S CNT=CNT+1
  1.  . S @TARGET@(CNT,0)="              Best Language: "_$G(STRING)
  1.  . S STRING=$G(VSTRARR(9000010.6315,NODE,".17","E"))
  1.  . S CNT=CNT+1
  1.  . S @TARGET@(CNT,0)="                 Dysarthria: "_$G(STRING)
  1.  . S STRING=$G(VSTRARR(9000010.6315,NODE,".18","E"))
  1.  . S CNT=CNT+1
  1.  . S @TARGET@(CNT,0)="   Extinction & Inattention: "_$G(STRING)
  1.  . S CNT=CNT+1
  1.  . S @TARGET@(CNT,0)="                            _______"
  1.  . S CNT=CNT+1
  1.  . S STRING=$G(VSTRARR(9000010.6315,NODE,".19","E")) ;          .19  TOTAL STROKE SCORE (NJ2,0), [0;19]
  1.  . S @TARGET@(CNT,0)="              * TOTAL SCORE: "_$G(STRING)
  1.  . S CNT=CNT_1
  1.  . S @TARGET@(CNT,0)=SPACE
  1.  . S STRING=$G(VSTRARR(9000010.6315,NODE,"1.01","E"))
  1.  . I $G(STRING)]"" D
  1.  .. S CNT=CNT+1
  1.  .. S @TARGET@(CNT,0)="Motor arm left comment: "
  1.  .. S CNT=CNT+1
  1.  .. S @TARGET@(CNT,0)="  "_$G(STRING)
  1.  . S STRING=$G(VSTRARR(9000010.6315,NODE,"1.02","E"))
  1.  . I $G(STRING)]"" D
  1.  .. S CNT=CNT+1
  1.  .. S @TARGET@(CNT,0)="Motor arm right comment: "
  1.  .. S CNT=CNT+1
  1.  .. S @TARGET@(CNT,0)="  "_$G(STRING)
  1.  . S STRING=$G(VSTRARR(9000010.6315,NODE,"2.01","E"))
  1.  . I $G(STRING)]"" D
  1.  .. S CNT=CNT+1
  1.  .. S @TARGET@(CNT,0)="Motor leg left comment: "
  1.  .. S CNT=CNT+1
  1.  .. S @TARGET@(CNT,0)="  "_$G(STRING)
  1.  . S STRING=$G(VSTRARR(9000010.6315,NODE,"2.02","E"))
  1.  . I $G(STRING)]"" D
  1.  .. S CNT=CNT+1
  1.  .. S @TARGET@(CNT,0)="Motor leg right comment: "
  1.  .. S CNT=CNT+1
  1.  .. S @TARGET@(CNT,0)="  "_$G(STRING)
  1.  . S STRING=$G(VSTRARR(9000010.6315,NODE,"3.01","E"))
  1.  . I $G(STRING)]"" D
  1.  .. S CNT=CNT+1
  1.  .. S @TARGET@(CNT,0)="Limb ataxia comment: "
  1.  .. S CNT=CNT+1
  1.  .. S @TARGET@(CNT,0)="  "_$G(STRING)
  1.  . S STRING=$G(VSTRARR(9000010.6315,NODE,"3.02","E"))
  1.  . I $G(STRING)]"" D
  1.  .. S CNT=CNT+1
  1.  .. S @TARGET@(CNT,0)="Dysarthia comment: "
  1.  .. S CNT=CNT+1
  1.  .. S @TARGET@(CNT,0)="  "_$G(STRING)
  1.  . S CNT=CNT+1
  1.  . S @TARGET@(CNT,0)=SPACE
  1.  Q
  1.  ;
  1.  ; -- find patient weight from visit or default to last filed weight in V Measurement file --
  1. WEIGHT(VIEN) ; -- from routine BTIULO4 --
  1.  NEW MIEN,QUALIF
  1.  S WT=0
  1.  S MIEN=0 F  S MIEN=$O(^AUPNVMSR("AD",VIEN,MIEN)) Q:'MIEN  D
  1.  . K TIU D ENP^XBDIQ1(9000010.01,MIEN,".01;.04;2;1201","TIU(","I")
  1.  . I TIU(.01)="WT" I TIU(2,"I")'=1     ;SKIP ENTERED IN ERROR VITALS
  1.  . S QUALIF=$$QUAL^BTIULO7A(MIEN)
  1.  . I TIU(.01)="WT" D
  1.  . . S TIU(.04)=$J(TIU(.04),5,2)_" ("_$J((TIU(.04)*.454),5,2)_" kg)"
  1.  . . I QUALIF="" S WT=$$NAME(TIU(.01,"I"))_": "_TIU(.04)_$$LSTDATE^BTIUPCC1(VIEN,TIU(1201,"I"),1)
  1.  . . I QUALIF'="" S WT=$$NAME(TIU(.01,"I"))_": "_TIU(.04)_$$LSTDATE^BTIUPCC1(VIEN,TIU(1201,"I"),1)_" Qualifiers: "_QUALIF
  1.  . . Q
  1.  . Q
  1.  K TIU
  1.  S:WT=0 WT=$$LASTMSR^BTIUPCC1(+$G(DFN),"WT",1,1)
  1.  Q
  1.  ;
  1. NAME(X) ;return full name for measurement
  1.  Q $$GET1^DIQ(9999999.07,X,.02)
  1.  ;
  1.  ; -- V STROKE file number --
  1. FNUM() ; returns 0/invalid file ref number, 9000010.63/valid file ref number
  1.  NEW FILEN,ATTRIB,TAROOT,MSGROOT,FILEINFO
  1.  S FILEN=9000010.63,ATTRIB="NAME;GLOBAL NAME",TAROOT="FILEINFO",MSGROOT="FILERR"
  1.  D FILE^DID(FILEN,,ATTRIB,TAROOT,MSGROOT)
  1.  I $D(FILERR) Q 0
  1.  Q 9000010.63