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

BTIUVSTR.m

Go to the documentation of this file. 
  1. BTIUVSTR ; IHS/MSC/JS - V STROKE TOOL OBJECT ;31-Mar-2014 08:33;DU
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**1012,1013**;MAR 20, 2013;Build 33
  1.  ;
  1.  Q
  1.  ;
  1. VSTR(DFN,TARGET,VIEN) ; EHR p12
  1.  ;
  1.  ;Input validation
  1.  ; -- check environment variables --
  1.  I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
  1.  I $G(TARGET)="" Q " "
  1.  K @TARGET
  1.  ;
  1.  ; -- get patient visit --
  1.  S VIEN=$G(VIEN)
  1.  I VIEN'="" G GETVSTR
  1.  NEW VST
  1.  S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
  1.  I VST="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
  1.  S VIEN=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1 S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
  1.  I $G(VIEN)="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
  1.  ;
  1. GETVSTR ; -- check/get V STROKE file #9000010.63 for entry --
  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 $P($G(^AUPNVSTR(STRIEN,5)),U,1) Q  ; EIE
  1.  .D GETS
  1.  I 'CNT S @TARGET@(1,0)="No Stroke data found for this visit"
  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 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.  D PRINT(STRIEN)
  1.  I CNT=0 S @TARGET@(1,0)="No V STROKE entry for patient visit"
  1.  Q
  1.  ; -- print the V Stroke data --
  1. PRINT(STRIEN) ;
  1.  NEW SPACE,ARRIVED,PATNAME,HANDED,FIBINIT,ARRCOM
  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 CNT=CNT+1
  1.  S @TARGET@(CNT,0)="--- Stroke Symptoms ---"
  1.  S CNT=CNT+1
  1.  S @TARGET@(CNT,0)=SPACE
  1.  S CNT=CNT+1
  1.  S @TARGET@(CNT,0)="Arrived at:   "_$G(ARRIVED)
  1.  I $D(VSTRARR(FNUM,STRIEN_",","1","1")) D  ; 1      COMMENT (DATE/TIME ARRIVAL)
  1.  .S CNT=CNT+1
  1.  .S @TARGET@(CNT,0)="Arrival Comments:"
  1.  .NEW NUM
  1.  .S NUM=""
  1.  .F  S NUM=$O(VSTRARR(FNUM,STRIEN_",","1",NUM)) Q:NUM=""!(NUM'?1N.N)  D
  1.  ..S ARRCOM=$G(VSTRARR(FNUM,STRIEN_",","1",NUM))
  1.  ..I $G(ARRCOM)]"" D
  1.  ..S CNT=CNT+1
  1.  ..S @TARGET@(CNT,0)=" "_ARRCOM
  1.  ;
  1.  ;STROKE SYMPTOMS #9000010.6314 -- STROKE SYMPTOMS SUB-FILE FIELD #1400
  1.  I $D(VSTRARR(9000010.6314)) D
  1.  .NEW STRING,NODE,NARR
  1.  .S CNT=CNT+1
  1.  .S @TARGET@(CNT,0)="Symptoms:"
  1.  .S STRING="",NODE=""
  1.  .F  S NODE=$O(VSTRARR(9000010.6314,NODE)) Q:NODE=""  D
  1.  ..S STRING=$G(VSTRARR(9000010.6314,NODE,".019","E")) ;              .019 SNOMED PREF TERM (CJ60)
  1.  ..I STRING]"" S CNT=CNT+1 S @TARGET@(CNT,0)=" "_$G(STRING)
  1.  ..I STRING="" D
  1.  ...S CNT=CNT+1
  1.  ...S STRING=$G(VSTRARR(9000010.6314,NODE,".03","E")) ;               .03 PROVIDER TEXT (P9999999.27O)
  1.  ...I STRING]"" S CNT=CNT+1 S @TARGET@(CNT,0)=" "_$G(STRING) ;        (DISPLAY IF SNOMED PREF TERM NULL)
  1.  ..S CNT=CNT+1
  1.  ..S STRING=$G(VSTRARR(9000010.6314,NODE,".06","E")) ;               .06  WITNESSED? (S), [0;6]
  1.  ..S STRING=$S(STRING="YES":"Witnessed - Yes",1:"Not Witnessed")
  1.  ..S @TARGET@(CNT,0)=$G(STRING)
  1.  ..I STRING["Yes" D
  1.  ...N WITBY S WITBY=$G(VSTRARR(9000010.6314,NODE,".07","E")) ;       .07  WITNESSED BY (F), [0;7]
  1.  ...N WITDT S WITDT=$G(VSTRARR(9000010.6314,NODE,".08","E")) ;       .08  DATE/TIME WITNESSED (D), [0;8]
  1.  ...N WITSTRG S WITSTRG="Witnessed Date/Time: "_$G(WITDT)_$S($G(WITBY)]"":" By "_WITBY,1:" ")
  1.  ...S CNT=CNT+1
  1.  ...S @TARGET@(CNT,0)=WITSTRG
  1.  ..S STRING=$G(VSTRARR(9000010.6314,NODE,".1","E")) ;                .1   BASELINE STATE DATE/TIME (D), [0;10]
  1.  ..I STRING]"" D
  1.  ...S CNT=CNT+1
  1.  ...S @TARGET@(CNT,0)="Last known at baseline state: "_$G(STRING)
  1.  ..S STRING=$G(VSTRARR(9000010.6314,NODE,".01","E")) ;               .01  CONCEPT ID (F), [0;1]
  1.  ..S NARR=$P($$DESC^BSTSAPI(STRING),U,2)
  1.  ..I NARR]"" D
  1.  ...S CNT=CNT+1
  1.  ...S @TARGET@(CNT,0)="EKG Interpretation: "_$G(NARR)
  1.  ;
  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.  ;
  1.  ;NIH STROKE SCALE #9000010.6315 -- NIH STROKE SCALE SUB-FILE FIELD #1500
  1.  NEW STRING,NODE,SSTIME
  1.  S STRING="",NODE=""
  1.  F  S NODE=$O(VSTRARR(9000010.6315,NODE)) Q:NODE=""  D
  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 SSTIME=$G(VSTRARR(9000010.6315,NODE,".02","E")) ;               .02  Time of score (Event Date/Time)
  1.  . S @TARGET@(CNT,0)="Stroke Score: "_$G(STRING)_"  on "_SSTIME
  1.  . Q
  1.  ;
  1.  ;PROTOCOL STANDING ORDERS #9000010.6313 -- PROTOCOL STANDING ORDERS SUB-FILE FIELD #1300
  1.  I $D(VSTRARR(9000010.6313)) D
  1.  .NEW STRING,NODE,PROTO,PROTODT,PROTOBY
  1.  .S CNT=CNT+1
  1.  .S @TARGET@(CNT,0)="Standing orders/Protocols Initiated -"
  1.  .S STRING="",NODE=""
  1.  .F  S NODE=$O(VSTRARR(9000010.6313,NODE)) Q:NODE=""  D
  1.  ..S CNT=CNT+1
  1.  ..S PROTO=$G(VSTRARR(9000010.6313,NODE,".01","E")) ;            .01  PROTOCOL STANDING ORDERS (F), [0;1]
  1.  ..S PROTODT=$G(VSTRARR(9000010.6313,NODE,".02","E")) ;          .02  EVENT DATE/TIME (D), [0;2]
  1.  ..S PROTOBY=$G(VSTRARR(9000010.6313,NODE,".04","E")) ;          .04  ENTERED BY (P200'), [0;4]
  1.  ..S CNT=CNT+1
  1.  ..S @TARGET@(CNT,0)=$G(PROTO)_"  "_$G(PROTODT)_" by "_$G(PROTOBY)
  1.  ..I $D(VSTRARR(9000010.6313,NODE,1,1)) D  ;                       1  STANDING ORDER COMMENT (Wx) LINE 1
  1.  ...S CNT=CNT+1
  1.  ...S @TARGET@(CNT,0)="Standing Order Comments:"
  1.  ...NEW NUM,PSOCOM
  1.  ...S NUM=""
  1.  ...F  S NUM=$O(VSTRARR(9000010.6313,NODE,1,NUM)) Q:NUM=""!(NUM'?1N.N)  D
  1.  ....S PSOCOM=$G(VSTRARR(9000010.6313,NODE,1,NUM))
  1.  ....I $G(PSOCOM)]"" D
  1.  .....S CNT=CNT+1
  1.  .....S @TARGET@(CNT,0)=" "_PSOCOM
  1.  ;
  1.  ;FIBRINOLYTIC THERAPY INITIATED  FIELD .11
  1.  NEW FIBSTDT,FIBNOT,FIBREA,FIBCOM,FIBTXT,FIBBY
  1.  S FIBSTDT=$G(VSTRARR(FNUM,STRIEN_",",".11","E")) ;               .11 FIBRINOLYTIC THERAPY INITIATED (D), [0;11]
  1.  S FIBBY=$G(VSTRARR(FNUM,STRIEN_",",".13","E"))
  1.  I FIBSTDT="" D
  1.  . S FIBNOT=$G(VSTRARR(FNUM,STRIEN_",",".14","E")) ;              .14 DID NOT DO
  1.  . I FIBNOT'="" D
  1.  ..S CNT=CNT+1
  1.  ..S @TARGET@(CNT,0)="Fibrinolytic therapy Not chosen at "_FIBNOT
  1.  ..S FIBREA=$G(VSTRARR(FNUM,STRIEN_",",".17","I")) ;              .17 NO FIB REASON (REF REASON FILE IEN STORED 12.6.13)
  1.  ..I $L(FIBREA)<4 S FIBTXT=FIBREA
  1.  ..E  S FIBTXT=$P($$CONC^BSTSAPI(FIBREA),U,4)
  1.  ..I FIBTXT]"" D
  1.  ...S CNT=CNT+1
  1.  ...S @TARGET@(CNT,0)="Reason: "_FIBTXT
  1.  E  D
  1.  .S CNT=CNT+1
  1.  .S @TARGET@(CNT,0)="Fibrinolytic therapy started at "_FIBSTDT
  1.  I FIBBY'="" D
  1.  .S CNT=CNT+1
  1.  .S @TARGET@(CNT,0)="Fibrinolytic documented by "_FIBBY
  1.  ;
  1.  I $D(VSTRARR(FNUM,STRIEN_",","4","1")) D  ;  4 FIBRINOLYTIC THERAPY COMMENT
  1.  .S CNT=CNT+1
  1.  .S @TARGET@(CNT,0)="Fibrinolytic Therapy Comments:"
  1.  .NEW NUM
  1.  .S NUM=""
  1.  .F  S NUM=$O(VSTRARR(FNUM,STRIEN_",","4",NUM)) Q:NUM=""!(NUM'?1N.N)  D
  1.  ..S FIBCOM=$G(VSTRARR(FNUM,STRIEN_",","4",NUM))
  1.  ..I $G(FIBCOM)]"" D
  1.  ..S CNT=CNT+1
  1.  ..S @TARGET@(CNT,0)=" "_FIBCOM
  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