BTIUVSTR ; IHS/MSC/JS - V STROKE TOOL OBJECT ;31-Mar-2014 08:33;DU
;;1.0;TEXT INTEGRATION UTILITIES;**1012,1013**;MAR 20, 2013;Build 33
;
Q
;
VSTR(DFN,TARGET,VIEN) ; EHR p12
;
;Input validation
; -- check environment variables --
I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
I $G(TARGET)="" Q " "
K @TARGET
;
; -- get patient visit --
S VIEN=$G(VIEN)
I VIEN'="" G GETVSTR
NEW VST
S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
I VST="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
S VIEN=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1 S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
I $G(VIEN)="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
;
GETVSTR ; -- check/get V STROKE file #9000010.63 for entry --
NEW STRIEN,CNT,FNUM,VSTRARR,VSTRERR
S STRIEN=""
S CNT=0
F S STRIEN=$O(^AUPNVSTR("AD",VIEN,STRIEN)) Q:STRIEN="" D
.I '$D(^AUPNVSTR(STRIEN)) Q ; broken record
.I $P($G(^AUPNVSTR(STRIEN,5)),U,1) Q ; EIE
.D GETS
I 'CNT S @TARGET@(1,0)="No Stroke data found for this visit"
Q "~@"_$NA(@TARGET)
;
GETS ; -- check/retrieve file entry --
S FNUM=$$FNUM
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)
K VSTRARR,VSTRERR
D GETS^DIQ(FNUM,STRIEN_",","**","IE","VSTRARR","VSTRERR") ; retrieve file entry data
I $D(VSTRERR) D Q "~@"_$NA(@TARGET)
.S @TARGET@(1,0)="Server error: "_$G(VSTRERR("DIERR",1))_U_$G(VSTRERR("DIERR",1,"TEXT",1))
;
NEW WT
D WEIGHT(VIEN)
D PRINT(STRIEN)
I CNT=0 S @TARGET@(1,0)="No V STROKE entry for patient visit"
Q
; -- print the V Stroke data --
PRINT(STRIEN) ;
NEW SPACE,ARRIVED,PATNAME,HANDED,FIBINIT,ARRCOM
S $P(SPACE," ",1)=""
S ARRIVED=$G(VSTRARR(FNUM,STRIEN_",",".01","E")) ;.01 ARRIVAL DATE/TIME (RD), [0;1]
S PATNAME=$G(VSTRARR(FNUM,STRIEN_",",".02","E")) ;.02 PATIENT NAME (RP9000001'I), [0;2]
S HANDED=$G(VSTRARR(FNUM,STRIEN_",",".04","E")) ; .04 HANDEDNESS (F), [0;4]
S CNT=CNT+1
S @TARGET@(CNT,0)="--- Stroke Symptoms ---"
S CNT=CNT+1
S @TARGET@(CNT,0)=SPACE
S CNT=CNT+1
S @TARGET@(CNT,0)="Arrived at: "_$G(ARRIVED)
I $D(VSTRARR(FNUM,STRIEN_",","1","1")) D ; 1 COMMENT (DATE/TIME ARRIVAL)
.S CNT=CNT+1
.S @TARGET@(CNT,0)="Arrival Comments:"
.NEW NUM
.S NUM=""
.F S NUM=$O(VSTRARR(FNUM,STRIEN_",","1",NUM)) Q:NUM=""!(NUM'?1N.N) D
..S ARRCOM=$G(VSTRARR(FNUM,STRIEN_",","1",NUM))
..I $G(ARRCOM)]"" D
..S CNT=CNT+1
..S @TARGET@(CNT,0)=" "_ARRCOM
;
;STROKE SYMPTOMS #9000010.6314 -- STROKE SYMPTOMS SUB-FILE FIELD #1400
I $D(VSTRARR(9000010.6314)) D
.NEW STRING,NODE,NARR
.S CNT=CNT+1
.S @TARGET@(CNT,0)="Symptoms:"
.S STRING="",NODE=""
.F S NODE=$O(VSTRARR(9000010.6314,NODE)) Q:NODE="" D
..S STRING=$G(VSTRARR(9000010.6314,NODE,".019","E")) ; .019 SNOMED PREF TERM (CJ60)
..I STRING]"" S CNT=CNT+1 S @TARGET@(CNT,0)=" "_$G(STRING)
..I STRING="" D
...S CNT=CNT+1
...S STRING=$G(VSTRARR(9000010.6314,NODE,".03","E")) ; .03 PROVIDER TEXT (P9999999.27O)
...I STRING]"" S CNT=CNT+1 S @TARGET@(CNT,0)=" "_$G(STRING) ; (DISPLAY IF SNOMED PREF TERM NULL)
..S CNT=CNT+1
..S STRING=$G(VSTRARR(9000010.6314,NODE,".06","E")) ; .06 WITNESSED? (S), [0;6]
..S STRING=$S(STRING="YES":"Witnessed - Yes",1:"Not Witnessed")
..S @TARGET@(CNT,0)=$G(STRING)
..I STRING["Yes" D
...N WITBY S WITBY=$G(VSTRARR(9000010.6314,NODE,".07","E")) ; .07 WITNESSED BY (F), [0;7]
...N WITDT S WITDT=$G(VSTRARR(9000010.6314,NODE,".08","E")) ; .08 DATE/TIME WITNESSED (D), [0;8]
...N WITSTRG S WITSTRG="Witnessed Date/Time: "_$G(WITDT)_$S($G(WITBY)]"":" By "_WITBY,1:" ")
...S CNT=CNT+1
...S @TARGET@(CNT,0)=WITSTRG
..S STRING=$G(VSTRARR(9000010.6314,NODE,".1","E")) ; .1 BASELINE STATE DATE/TIME (D), [0;10]
..I STRING]"" D
...S CNT=CNT+1
...S @TARGET@(CNT,0)="Last known at baseline state: "_$G(STRING)
..S STRING=$G(VSTRARR(9000010.6314,NODE,".01","E")) ; .01 CONCEPT ID (F), [0;1]
..S NARR=$P($$DESC^BSTSAPI(STRING),U,2)
..I NARR]"" D
...S CNT=CNT+1
...S @TARGET@(CNT,0)="EKG Interpretation: "_$G(NARR)
;
S CNT=CNT+1
S @TARGET@(CNT,0)="Handedness: "_$G(HANDED)
S CNT=CNT+1
S @TARGET@(CNT,0)="Weight: "_$G(WT)
;
;NIH STROKE SCALE #9000010.6315 -- NIH STROKE SCALE SUB-FILE FIELD #1500
NEW STRING,NODE,SSTIME
S STRING="",NODE=""
F S NODE=$O(VSTRARR(9000010.6315,NODE)) Q:NODE="" D
. S CNT=CNT+1
. S STRING=$G(VSTRARR(9000010.6315,NODE,".19","E")) ; .19 TOTAL STROKE SCORE (NJ2,0), [0;19]
. S SSTIME=$G(VSTRARR(9000010.6315,NODE,".02","E")) ; .02 Time of score (Event Date/Time)
. S @TARGET@(CNT,0)="Stroke Score: "_$G(STRING)_" on "_SSTIME
. Q
;
;PROTOCOL STANDING ORDERS #9000010.6313 -- PROTOCOL STANDING ORDERS SUB-FILE FIELD #1300
I $D(VSTRARR(9000010.6313)) D
.NEW STRING,NODE,PROTO,PROTODT,PROTOBY
.S CNT=CNT+1
.S @TARGET@(CNT,0)="Standing orders/Protocols Initiated -"
.S STRING="",NODE=""
.F S NODE=$O(VSTRARR(9000010.6313,NODE)) Q:NODE="" D
..S CNT=CNT+1
..S PROTO=$G(VSTRARR(9000010.6313,NODE,".01","E")) ; .01 PROTOCOL STANDING ORDERS (F), [0;1]
..S PROTODT=$G(VSTRARR(9000010.6313,NODE,".02","E")) ; .02 EVENT DATE/TIME (D), [0;2]
..S PROTOBY=$G(VSTRARR(9000010.6313,NODE,".04","E")) ; .04 ENTERED BY (P200'), [0;4]
..S CNT=CNT+1
..S @TARGET@(CNT,0)=$G(PROTO)_" "_$G(PROTODT)_" by "_$G(PROTOBY)
..I $D(VSTRARR(9000010.6313,NODE,1,1)) D ; 1 STANDING ORDER COMMENT (Wx) LINE 1
...S CNT=CNT+1
...S @TARGET@(CNT,0)="Standing Order Comments:"
...NEW NUM,PSOCOM
...S NUM=""
...F S NUM=$O(VSTRARR(9000010.6313,NODE,1,NUM)) Q:NUM=""!(NUM'?1N.N) D
....S PSOCOM=$G(VSTRARR(9000010.6313,NODE,1,NUM))
....I $G(PSOCOM)]"" D
.....S CNT=CNT+1
.....S @TARGET@(CNT,0)=" "_PSOCOM
;
;FIBRINOLYTIC THERAPY INITIATED FIELD .11
NEW FIBSTDT,FIBNOT,FIBREA,FIBCOM,FIBTXT,FIBBY
S FIBSTDT=$G(VSTRARR(FNUM,STRIEN_",",".11","E")) ; .11 FIBRINOLYTIC THERAPY INITIATED (D), [0;11]
S FIBBY=$G(VSTRARR(FNUM,STRIEN_",",".13","E"))
I FIBSTDT="" D
. S FIBNOT=$G(VSTRARR(FNUM,STRIEN_",",".14","E")) ; .14 DID NOT DO
. I FIBNOT'="" D
..S CNT=CNT+1
..S @TARGET@(CNT,0)="Fibrinolytic therapy Not chosen at "_FIBNOT
..S FIBREA=$G(VSTRARR(FNUM,STRIEN_",",".17","I")) ; .17 NO FIB REASON (REF REASON FILE IEN STORED 12.6.13)
..I $L(FIBREA)<4 S FIBTXT=FIBREA
..E S FIBTXT=$P($$CONC^BSTSAPI(FIBREA),U,4)
..I FIBTXT]"" D
...S CNT=CNT+1
...S @TARGET@(CNT,0)="Reason: "_FIBTXT
E D
.S CNT=CNT+1
.S @TARGET@(CNT,0)="Fibrinolytic therapy started at "_FIBSTDT
I FIBBY'="" D
.S CNT=CNT+1
.S @TARGET@(CNT,0)="Fibrinolytic documented by "_FIBBY
;
I $D(VSTRARR(FNUM,STRIEN_",","4","1")) D ; 4 FIBRINOLYTIC THERAPY COMMENT
.S CNT=CNT+1
.S @TARGET@(CNT,0)="Fibrinolytic Therapy Comments:"
.NEW NUM
.S NUM=""
.F S NUM=$O(VSTRARR(FNUM,STRIEN_",","4",NUM)) Q:NUM=""!(NUM'?1N.N) D
..S FIBCOM=$G(VSTRARR(FNUM,STRIEN_",","4",NUM))
..I $G(FIBCOM)]"" D
..S CNT=CNT+1
..S @TARGET@(CNT,0)=" "_FIBCOM
.S CNT=CNT+1
.S @TARGET@(CNT,0)=SPACE
Q
;
; -- find patient weight from visit or default to last filed weight in V Measurement file --
WEIGHT(VIEN) ; -- from routine BTIULO4 --
NEW MIEN,QUALIF
S WT=0
S MIEN=0 F S MIEN=$O(^AUPNVMSR("AD",VIEN,MIEN)) Q:'MIEN D
. K TIU D ENP^XBDIQ1(9000010.01,MIEN,".01;.04;2;1201","TIU(","I")
. I TIU(.01)="WT" I TIU(2,"I")'=1 ;SKIP ENTERED IN ERROR VITALS
. S QUALIF=$$QUAL^BTIULO7A(MIEN)
. I TIU(.01)="WT" D
. . S TIU(.04)=$J(TIU(.04),5,2)_" ("_$J((TIU(.04)*.454),5,2)_" kg)"
. . I QUALIF="" S WT=$$NAME(TIU(.01,"I"))_": "_TIU(.04)_$$LSTDATE^BTIUPCC1(VIEN,TIU(1201,"I"),1)
. . I QUALIF'="" S WT=$$NAME(TIU(.01,"I"))_": "_TIU(.04)_$$LSTDATE^BTIUPCC1(VIEN,TIU(1201,"I"),1)_" Qualifiers: "_QUALIF
. . Q
. Q
K TIU
S:WT=0 WT=$$LASTMSR^BTIUPCC1(+$G(DFN),"WT",1,1)
Q
;
NAME(X) ;return full name for measurement
Q $$GET1^DIQ(9999999.07,X,.02)
;
; -- V STROKE file number --
FNUM() ; returns 0/invalid file ref number, 9000010.63/valid file ref number
NEW FILEN,ATTRIB,TAROOT,MSGROOT,FILEINFO
S FILEN=9000010.63,ATTRIB="NAME;GLOBAL NAME",TAROOT="FILEINFO",MSGROOT="FILERR"
D FILE^DID(FILEN,,ATTRIB,TAROOT,MSGROOT)
I $D(FILERR) Q 0
Q 9000010.63
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
+2 ;
+3 QUIT
+4 ;
VSTR(DFN,TARGET,VIEN) ; EHR p12
+1 ;
+2 ;Input validation
+3 ; -- check environment variables --
+4 IF $TEXT(GETVAR^CIAVMEVT)=""
SET @TARGET@(1,0)="Invalid context variables"
QUIT "~@"_$NAME(@TARGET)
+5 IF $GET(TARGET)=""
QUIT " "
+6 KILL @TARGET
+7 ;
+8 ; -- get patient visit --
+9 SET VIEN=$GET(VIEN)
+10 IF VIEN'=""
GOTO GETVSTR
+11 NEW VST
+12 SET VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
+13 IF VST=""
SET @TARGET@(1,0)="Invalid visit"
QUIT "~@"_$NAME(@TARGET)
+14 SET VIEN=+$$VSTR2VIS^BEHOENCX(DFN,VST)
IF VST<1
SET @TARGET@(1,0)="Invalid context variables"
QUIT "~@"_$NAME(@TARGET)
+15 IF $GET(VIEN)=""
SET @TARGET@(1,0)="Invalid visit"
QUIT "~@"_$NAME(@TARGET)
+16 ;
GETVSTR ; -- check/get V STROKE file #9000010.63 for entry --
+1 NEW STRIEN,CNT,FNUM,VSTRARR,VSTRERR
+2 SET STRIEN=""
+3 SET CNT=0
+4 FOR
SET STRIEN=$ORDER(^AUPNVSTR("AD",VIEN,STRIEN))
IF STRIEN=""
QUIT
Begin DoDot:1
+5 ; broken record
IF '$DATA(^AUPNVSTR(STRIEN))
QUIT
+6 ; EIE
IF $PIECE($GET(^AUPNVSTR(STRIEN,5)),U,1)
QUIT
+7 DO GETS
End DoDot:1
+8 IF 'CNT
SET @TARGET@(1,0)="No Stroke data found for this visit"
+9 QUIT "~@"_$NAME(@TARGET)
+10 ;
GETS ; -- check/retrieve file entry --
+1 SET FNUM=$$FNUM
+2 IF FNUM=0
SET @TARGET@(1,0)="Server error: "_$GET(FILERR("DIERR",1))_U_$GET(FILERR("DIERR",1,"TEXT",1))
KILL FILERR
QUIT "~@"_$NAME(@TARGET)
+3 KILL VSTRARR,VSTRERR
+4 ; retrieve file entry data
DO GETS^DIQ(FNUM,STRIEN_",","**","IE","VSTRARR","VSTRERR")
+5 IF $DATA(VSTRERR)
Begin DoDot:1
+6 SET @TARGET@(1,0)="Server error: "_$GET(VSTRERR("DIERR",1))_U_$GET(VSTRERR("DIERR",1,"TEXT",1))
End DoDot:1
QUIT "~@"_$NAME(@TARGET)
+7 ;
+8 NEW WT
+9 DO WEIGHT(VIEN)
+10 DO PRINT(STRIEN)
+11 IF CNT=0
SET @TARGET@(1,0)="No V STROKE entry for patient visit"
+12 QUIT
+13 ; -- print the V Stroke data --
PRINT(STRIEN) ;
+1 NEW SPACE,ARRIVED,PATNAME,HANDED,FIBINIT,ARRCOM
+2 SET $PIECE(SPACE," ",1)=""
+3 ;.01 ARRIVAL DATE/TIME (RD), [0;1]
SET ARRIVED=$GET(VSTRARR(FNUM,STRIEN_",",".01","E"))
+4 ;.02 PATIENT NAME (RP9000001'I), [0;2]
SET PATNAME=$GET(VSTRARR(FNUM,STRIEN_",",".02","E"))
+5 ; .04 HANDEDNESS (F), [0;4]
SET HANDED=$GET(VSTRARR(FNUM,STRIEN_",",".04","E"))
+6 SET CNT=CNT+1
+7 SET @TARGET@(CNT,0)="--- Stroke Symptoms ---"
+8 SET CNT=CNT+1
+9 SET @TARGET@(CNT,0)=SPACE
+10 SET CNT=CNT+1
+11 SET @TARGET@(CNT,0)="Arrived at: "_$GET(ARRIVED)
+12 ; 1 COMMENT (DATE/TIME ARRIVAL)
IF $DATA(VSTRARR(FNUM,STRIEN_",","1","1"))
Begin DoDot:1
+13 SET CNT=CNT+1
+14 SET @TARGET@(CNT,0)="Arrival Comments:"
+15 NEW NUM
+16 SET NUM=""
+17 FOR
SET NUM=$ORDER(VSTRARR(FNUM,STRIEN_",","1",NUM))
IF NUM=""!(NUM'?1N.N)
QUIT
Begin DoDot:2
+18 SET ARRCOM=$GET(VSTRARR(FNUM,STRIEN_",","1",NUM))
+19 IF $GET(ARRCOM)]""
Begin DoDot:3
End DoDot:3
+20 SET CNT=CNT+1
+21 SET @TARGET@(CNT,0)=" "_ARRCOM
End DoDot:2
End DoDot:1
+22 ;
+23 ;STROKE SYMPTOMS #9000010.6314 -- STROKE SYMPTOMS SUB-FILE FIELD #1400
+24 IF $DATA(VSTRARR(9000010.6314))
Begin DoDot:1
+25 NEW STRING,NODE,NARR
+26 SET CNT=CNT+1
+27 SET @TARGET@(CNT,0)="Symptoms:"
+28 SET STRING=""
SET NODE=""
+29 FOR
SET NODE=$ORDER(VSTRARR(9000010.6314,NODE))
IF NODE=""
QUIT
Begin DoDot:2
+30 ; .019 SNOMED PREF TERM (CJ60)
SET STRING=$GET(VSTRARR(9000010.6314,NODE,".019","E"))
+31 IF STRING]""
SET CNT=CNT+1
SET @TARGET@(CNT,0)=" "_$GET(STRING)
+32 IF STRING=""
Begin DoDot:3
+33 SET CNT=CNT+1
+34 ; .03 PROVIDER TEXT (P9999999.27O)
SET STRING=$GET(VSTRARR(9000010.6314,NODE,".03","E"))
+35 ; (DISPLAY IF SNOMED PREF TERM NULL)
IF STRING]""
SET CNT=CNT+1
SET @TARGET@(CNT,0)=" "_$GET(STRING)
End DoDot:3
+36 SET CNT=CNT+1
+37 ; .06 WITNESSED? (S), [0;6]
SET STRING=$GET(VSTRARR(9000010.6314,NODE,".06","E"))
+38 SET STRING=$SELECT(STRING="YES":"Witnessed - Yes",1:"Not Witnessed")
+39 SET @TARGET@(CNT,0)=$GET(STRING)
+40 IF STRING["Yes"
Begin DoDot:3
+41 ; .07 WITNESSED BY (F), [0;7]
NEW WITBY
SET WITBY=$GET(VSTRARR(9000010.6314,NODE,".07","E"))
+42 ; .08 DATE/TIME WITNESSED (D), [0;8]
NEW WITDT
SET WITDT=$GET(VSTRARR(9000010.6314,NODE,".08","E"))
+43 NEW WITSTRG
SET WITSTRG="Witnessed Date/Time: "_$GET(WITDT)_$SELECT($GET(WITBY)]"":" By "_WITBY,1:" ")
+44 SET CNT=CNT+1
+45 SET @TARGET@(CNT,0)=WITSTRG
End DoDot:3
+46 ; .1 BASELINE STATE DATE/TIME (D), [0;10]
SET STRING=$GET(VSTRARR(9000010.6314,NODE,".1","E"))
+47 IF STRING]""
Begin DoDot:3
+48 SET CNT=CNT+1
+49 SET @TARGET@(CNT,0)="Last known at baseline state: "_$GET(STRING)
End DoDot:3
+50 ; .01 CONCEPT ID (F), [0;1]
SET STRING=$GET(VSTRARR(9000010.6314,NODE,".01","E"))
+51 SET NARR=$PIECE($$DESC^BSTSAPI(STRING),U,2)
+52 IF NARR]""
Begin DoDot:3
+53 SET CNT=CNT+1
+54 SET @TARGET@(CNT,0)="EKG Interpretation: "_$GET(NARR)
End DoDot:3
End DoDot:2
End DoDot:1
+55 ;
+56 SET CNT=CNT+1
+57 SET @TARGET@(CNT,0)="Handedness: "_$GET(HANDED)
+58 SET CNT=CNT+1
+59 SET @TARGET@(CNT,0)="Weight: "_$GET(WT)
+60 ;
+61 ;NIH STROKE SCALE #9000010.6315 -- NIH STROKE SCALE SUB-FILE FIELD #1500
+62 NEW STRING,NODE,SSTIME
+63 SET STRING=""
SET NODE=""
+64 FOR
SET NODE=$ORDER(VSTRARR(9000010.6315,NODE))
IF NODE=""
QUIT
Begin DoDot:1
+65 SET CNT=CNT+1
+66 ; .19 TOTAL STROKE SCORE (NJ2,0), [0;19]
SET STRING=$GET(VSTRARR(9000010.6315,NODE,".19","E"))
+67 ; .02 Time of score (Event Date/Time)
SET SSTIME=$GET(VSTRARR(9000010.6315,NODE,".02","E"))
+68 SET @TARGET@(CNT,0)="Stroke Score: "_$GET(STRING)_" on "_SSTIME
+69 QUIT
End DoDot:1
+70 ;
+71 ;PROTOCOL STANDING ORDERS #9000010.6313 -- PROTOCOL STANDING ORDERS SUB-FILE FIELD #1300
+72 IF $DATA(VSTRARR(9000010.6313))
Begin DoDot:1
+73 NEW STRING,NODE,PROTO,PROTODT,PROTOBY
+74 SET CNT=CNT+1
+75 SET @TARGET@(CNT,0)="Standing orders/Protocols Initiated -"
+76 SET STRING=""
SET NODE=""
+77 FOR
SET NODE=$ORDER(VSTRARR(9000010.6313,NODE))
IF NODE=""
QUIT
Begin DoDot:2
+78 SET CNT=CNT+1
+79 ; .01 PROTOCOL STANDING ORDERS (F), [0;1]
SET PROTO=$GET(VSTRARR(9000010.6313,NODE,".01","E"))
+80 ; .02 EVENT DATE/TIME (D), [0;2]
SET PROTODT=$GET(VSTRARR(9000010.6313,NODE,".02","E"))
+81 ; .04 ENTERED BY (P200'), [0;4]
SET PROTOBY=$GET(VSTRARR(9000010.6313,NODE,".04","E"))
+82 SET CNT=CNT+1
+83 SET @TARGET@(CNT,0)=$GET(PROTO)_" "_$GET(PROTODT)_" by "_$GET(PROTOBY)
+84 ; 1 STANDING ORDER COMMENT (Wx) LINE 1
IF $DATA(VSTRARR(9000010.6313,NODE,1,1))
Begin DoDot:3
+85 SET CNT=CNT+1
+86 SET @TARGET@(CNT,0)="Standing Order Comments:"
+87 NEW NUM,PSOCOM
+88 SET NUM=""
+89 FOR
SET NUM=$ORDER(VSTRARR(9000010.6313,NODE,1,NUM))
IF NUM=""!(NUM'?1N.N)
QUIT
Begin DoDot:4
+90 SET PSOCOM=$GET(VSTRARR(9000010.6313,NODE,1,NUM))
+91 IF $GET(PSOCOM)]""
Begin DoDot:5
+92 SET CNT=CNT+1
+93 SET @TARGET@(CNT,0)=" "_PSOCOM
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+94 ;
+95 ;FIBRINOLYTIC THERAPY INITIATED FIELD .11
+96 NEW FIBSTDT,FIBNOT,FIBREA,FIBCOM,FIBTXT,FIBBY
+97 ; .11 FIBRINOLYTIC THERAPY INITIATED (D), [0;11]
SET FIBSTDT=$GET(VSTRARR(FNUM,STRIEN_",",".11","E"))
+98 SET FIBBY=$GET(VSTRARR(FNUM,STRIEN_",",".13","E"))
+99 IF FIBSTDT=""
Begin DoDot:1
+100 ; .14 DID NOT DO
SET FIBNOT=$GET(VSTRARR(FNUM,STRIEN_",",".14","E"))
+101 IF FIBNOT'=""
Begin DoDot:2
+102 SET CNT=CNT+1
+103 SET @TARGET@(CNT,0)="Fibrinolytic therapy Not chosen at "_FIBNOT
+104 ; .17 NO FIB REASON (REF REASON FILE IEN STORED 12.6.13)
SET FIBREA=$GET(VSTRARR(FNUM,STRIEN_",",".17","I"))
+105 IF $LENGTH(FIBREA)<4
SET FIBTXT=FIBREA
+106 IF '$TEST
SET FIBTXT=$PIECE($$CONC^BSTSAPI(FIBREA),U,4)
+107 IF FIBTXT]""
Begin DoDot:3
+108 SET CNT=CNT+1
+109 SET @TARGET@(CNT,0)="Reason: "_FIBTXT
End DoDot:3
End DoDot:2
End DoDot:1
+110 IF '$TEST
Begin DoDot:1
+111 SET CNT=CNT+1
+112 SET @TARGET@(CNT,0)="Fibrinolytic therapy started at "_FIBSTDT
End DoDot:1
+113 IF FIBBY'=""
Begin DoDot:1
+114 SET CNT=CNT+1
+115 SET @TARGET@(CNT,0)="Fibrinolytic documented by "_FIBBY
End DoDot:1
+116 ;
+117 ; 4 FIBRINOLYTIC THERAPY COMMENT
IF $DATA(VSTRARR(FNUM,STRIEN_",","4","1"))
Begin DoDot:1
+118 SET CNT=CNT+1
+119 SET @TARGET@(CNT,0)="Fibrinolytic Therapy Comments:"
+120 NEW NUM
+121 SET NUM=""
+122 FOR
SET NUM=$ORDER(VSTRARR(FNUM,STRIEN_",","4",NUM))
IF NUM=""!(NUM'?1N.N)
QUIT
Begin DoDot:2
+123 SET FIBCOM=$GET(VSTRARR(FNUM,STRIEN_",","4",NUM))
+124 IF $GET(FIBCOM)]""
Begin DoDot:3
End DoDot:3
+125 SET CNT=CNT+1
+126 SET @TARGET@(CNT,0)=" "_FIBCOM
End DoDot:2
+127 SET CNT=CNT+1
+128 SET @TARGET@(CNT,0)=SPACE
End DoDot:1
+129 QUIT
+130 ;
+131 ; -- find patient weight from visit or default to last filed weight in V Measurement file --
WEIGHT(VIEN) ; -- from routine BTIULO4 --
+1 NEW MIEN,QUALIF
+2 SET WT=0
+3 SET MIEN=0
FOR
SET MIEN=$ORDER(^AUPNVMSR("AD",VIEN,MIEN))
IF 'MIEN
QUIT
Begin DoDot:1
+4 KILL TIU
DO ENP^XBDIQ1(9000010.01,MIEN,".01;.04;2;1201","TIU(","I")
+5 ;SKIP ENTERED IN ERROR VITALS
IF TIU(.01)="WT"
IF TIU(2,"I")'=1
+6 SET QUALIF=$$QUAL^BTIULO7A(MIEN)
+7 IF TIU(.01)="WT"
Begin DoDot:2
+8 SET TIU(.04)=$JUSTIFY(TIU(.04),5,2)_" ("_$JUSTIFY((TIU(.04)*.454),5,2)_" kg)"
+9 IF QUALIF=""
SET WT=$$NAME(TIU(.01,"I"))_": "_TIU(.04)_$$LSTDATE^BTIUPCC1(VIEN,TIU(1201,"I"),1)
+10 IF QUALIF'=""
SET WT=$$NAME(TIU(.01,"I"))_": "_TIU(.04)_$$LSTDATE^BTIUPCC1(VIEN,TIU(1201,"I"),1)_" Qualifiers: "_QUALIF
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 KILL TIU
+14 IF WT=0
SET WT=$$LASTMSR^BTIUPCC1(+$GET(DFN),"WT",1,1)
+15 QUIT
+16 ;
NAME(X) ;return full name for measurement
+1 QUIT $$GET1^DIQ(9999999.07,X,.02)
+2 ;
+3 ; -- V STROKE file number --
FNUM() ; returns 0/invalid file ref number, 9000010.63/valid file ref number
+1 NEW FILEN,ATTRIB,TAROOT,MSGROOT,FILEINFO
+2 SET FILEN=9000010.63
SET ATTRIB="NAME;GLOBAL NAME"
SET TAROOT="FILEINFO"
SET MSGROOT="FILERR"
+3 DO FILE^DID(FILEN,,ATTRIB,TAROOT,MSGROOT)
+4 IF $DATA(FILERR)
QUIT 0
+5 QUIT 9000010.63
