BGOVSTR2 ; MSC/JS - Utility calls for V STROKE ;12-Nov-2014 14:03;PLS
;;1.1;BGO COMPONENTS;**13,14**;Mar 20, 2007
;01.24.14 - MSC/JS - move SET here to keep within 15k routine size limits
;02.06.14 - MSC/MGH Changed field .17 to store text
;05.01.14 - MSC/DKA Allow neither Fib Init nor Fib Not Init.
;
;Add/edit V STROKE entry
SET(RET,INP) ;EP
; INP is an array of strings.
; The first string is the VFIEN^NumberOfLines^VisitIsLocked
; Each subsequent string is prefixed with a letter indicating the type of record:
; A - Arrival
; AT - Arrival Text (Comment)
; F - Fibrinolytic Therapy
; FT - Fibrinolytic Therapy Text (Comment)
; N - NIH Stroke Scale (Multiple)
; P - Protocol Standing Orders (Multiple)
; PT - Standing Order Comment (Multiple)
; SS - Stroke Symptoms (Multiple)
; ST - Stroke Symptoms EKG Findings Comment (Multiple)
; MA - NIH Motor Arm Comments
; ML - NIH Motor Limb Comments
; LA - NIH Limb Ataxia Comment
; DY - NIH Dysarthria Comment
N BASELINE,DESCT,I,FDA,FNUM,NI,NIHDATE,NIHTOTAL,NOW,NUMNEW,NARR,NARRPTR,REFUSED,AARDT,EVTDT,EVTSTR,FIBTXT,REFDT,DFN
N QIEN,DEL,QUAL,QUALS,SNOMED,SUBIEN,SUM,TYPE,VCODE,VFIEN,VFLDERR,VFNEW,VFSTR,VI,VIEN,VMIEN,VMINP,VISDAT,ARRDT,VFCOMM,VFVAL,FI
S RET="",FNUM=$$FNUM
S VFIEN=+INP(0)
S VFNEW='VFIEN
S VIEN=$P(INP(1),U,4)
S VISDAT=$G(^AUPNVSIT(VIEN,0))
S DFN=$P(VISDAT,U,5)
I $G(DFN)="" S RET=$$ERR^BGOUTL(1062) Q
S NOW=$$NOW^XLFDT ; Use the same value for Date/Time Entered fields
S RET=$$CHKVISIT^BGOUTL(VIEN) Q:RET
I VFNEW I VFIEN=0 S VFIEN=NOW
I VFNEW D VFNEW^BGOUTL2(.RET,FNUM,VFIEN,VIEN) S:RET>0 VFIEN=RET,RET=""
I 'VFIEN S RET=$$ERR^BGOUTL(1070) Q
S FDA=$NA(FDA(FNUM,VFIEN_","))
F VI=1:1:$P(INP(0),U,2) D
.S VFSTR=$G(INP(VI)) Q:VFSTR=""
.S VCODE=$P(VFSTR,U)
.I VCODE="A" D
..S FDA=$NA(FDA(FNUM,VFIEN_","))
..S ARRDT=$P(VFSTR,U,2)
..I ARRDT>0,ARRDT'["." S ARRDT=(ARRDT-1)+.24
..S @FDA@(.01)=ARRDT ;ArrivalDateTime
..S @FDA@(.04)=$P(VFSTR,U,3) ;Handedness
..S @FDA@(1203)=$$GET1^DIQ(44,$P(VFSTR,U,5),8,"I") ;Clinic
..S @FDA@(1204)=$P(VFSTR,U,6) ;EncounterProvider
..S EVTDT=$P(VFSTR,U,7)
..I EVTDT>0,EVTDT'["." S EVTDT=(EVTDT-1)+.24
..S @FDA@(1201)=EVTDT ;EventDateTime
..S BASELINE=EVTDT
.E I VCODE="AT" D
..S FDA=$NA(FDA(FNUM,VFIEN_","))
..S VFCOMM=$P(VFSTR,U,2) ; Comment (Date/Time Arrival)
..I VFCOMM="" S @FDA@(1)="@" ; Delete the comment, whether or not it already exists.
..E D
...S @FDA@(1)=$NA(FDA(FNUM,VFIEN_",",1))
...S @FDA@(1,0)=$G(@FDA@(1,0))+1
...S @FDA@(1,@FDA@(1,0))=VFCOMM
.E I VCODE="F" D
..; 2014-05-01 DKA If no date is sent, then clear both FibInit and FibNotInit fields,
..; else if a reason is not sent, set FibInit and clear FibNotInit fields,
..; otherwise set FibNotInit and clear FibInit fields.
..S FDA=$NA(FDA(FNUM,VFIEN_","))
..;First check to see if neither FT Initiated nor FT Not Initiated (None button checked)
..I $P(VFSTR,U,2,3)=U F FI=.11:.01:.17 S @FDA@(FI)="@" ; Clear all the FibInit and FibNotInit fields
..E I $P(VFSTR,U,4)="" D
...; FT Initiated
...S @FDA@(.11)=$P(VFSTR,U,2) ;FibrinolyticTherapyInitiated
...S:@FDA@(.11)'=""&(@FDA@(.11)'[".") @FDA@(.11)=@FDA@(.11)-1+.24
...S @FDA@(.12)=NOW,@FDA@(.13)=DUZ
...S @FDA@(.14)="@"
...S @FDA@(.15)="@"
...S @FDA@(.16)="@"
...S @FDA@(.17)="@"
...;IHS/MSC/MGH Try to remove any refusal reason if this is an edit
...D DELREF^BGOVSTR1(VFIEN)
..E D
...; FT Not Initiated
...S (@FDA@(.14),REFDT)=$P(VFSTR,U,3) ;DidNotInit
...S:@FDA@(.14)'=""&(@FDA@(.14)'[".") @FDA@(.14)=@FDA@(.14)-1+.24
...S @FDA@(.15)=NOW,@FDA@(.16)=DUZ
...;S (@FDA@(.17),REFUSED)=$P(VFSTR,U,4) ;DidnotInitReason
...S REFUSED=$P(VFSTR,U,4)
...S FIBTXT=$$GET1^DIQ(9999999.102,REFUSED,.01)
...S @FDA@(.17)=FIBTXT
...S @FDA@(.11)="@"
...S @FDA@(.12)="@"
...S @FDA@(.13)="@"
.E I VCODE="FT" D
..S FDA=$NA(FDA(FNUM,VFIEN_","))
..S VFCOMM=$P(VFSTR,U,2) ; Fibrinolytic Therapy Comment
..I VFCOMM="" S @FDA@(4)="@" ; Delete the comment, whether or not it already exists.
..E D
...S @FDA@(4)=$NA(FDA(FNUM,VFIEN_",",4))
...S @FDA@(4,0)=$G(@FDA@(4,0))+1
...S @FDA@(4,@FDA@(4,0))=VFCOMM
.E I VCODE="N" D ;NIH Stroke Scale (Multiple-9000010.6315), [15;0]
..S SUBIEN=$P(VFSTR,U,2)
..I $G(SUBIEN)]"" Q:'$D(^AUPNVSTR(VFIEN,15,+SUBIEN))
..S DEL=$P(VFSTR,U,5) ;Delete flag
..I +SUBIEN&(DEL="@") D DEL(RET,VFIEN,SUBIEN) Q
..I SUBIEN="" S NUMNEW=$G(NUMNEW)+1,SUBIEN="+"_NUMNEW
..S SUBIEN=SUBIEN_","_VFIEN_","
..S FDA=$NA(FDA(FNUM_15,SUBIEN))
..;$p3 = .01 field (DateTime)
..S @FDA@(.01)=$S($P(VFSTR,U,3)>0:$P(VFSTR,U,3),1:NOW)
..S:@FDA@(.01)'=""&(@FDA@(.01)'[".") @FDA@(.01)=@FDA@(.01)-1+.24
..S @FDA@(.02)=$P(VFSTR,U,4) ;.02
..S:@FDA@(.02)'=""&(@FDA@(.02)'[".") @FDA@(.02)=@FDA@(.02)-1+.24
..S @FDA@(.03)=DUZ ;.03
..S VFVAL=$P(VFSTR,U,6),@FDA@(.04)=$S(VFVAL="":"@",1:VFVAL) ;.04
..S VFVAL=$P(VFSTR,U,7),@FDA@(.05)=$S(VFVAL="":"@",1:VFVAL) ;.05
..S VFVAL=$P(VFSTR,U,8),@FDA@(.06)=$S(VFVAL="":"@",1:VFVAL) ;.06
..S VFVAL=$P(VFSTR,U,9),@FDA@(.07)=$S(VFVAL="":"@",1:VFVAL) ;.07
..S VFVAL=$P(VFSTR,U,10),@FDA@(.08)=$S(VFVAL="":"@",1:VFVAL) ;.08
..S VFVAL=$P(VFSTR,U,11),@FDA@(.09)=$S(VFVAL="":"@",1:VFVAL) ;.09
..S VFVAL=$P(VFSTR,U,12),@FDA@(.1)=$S(VFVAL="":"@",1:VFVAL) ;.1
..S VFVAL=$P(VFSTR,U,13),@FDA@(.11)=$S(VFVAL="":"@",1:VFVAL) ;.11
..S VFVAL=$P(VFSTR,U,14),@FDA@(.12)=$S(VFVAL="":"@",1:VFVAL) ;.12
..S VFVAL=$P(VFSTR,U,15),@FDA@(.13)=$S(VFVAL="":"@",1:VFVAL) ;.13
..S VFVAL=$P(VFSTR,U,16),@FDA@(.14)=$S(VFVAL="":"@",1:VFVAL) ;.14
..S VFVAL=$P(VFSTR,U,17),@FDA@(.15)=$S(VFVAL="":"@",1:VFVAL) ;.15
..S VFVAL=$P(VFSTR,U,18),@FDA@(.16)=$S(VFVAL="":"@",1:VFVAL) ;.16
..S VFVAL=$P(VFSTR,U,19),@FDA@(.17)=$S(VFVAL="":"@",1:VFVAL) ;.17
..S VFVAL=$P(VFSTR,U,20),@FDA@(.18)=$S(VFVAL="":"@",1:VFVAL) ;.18
..S NIHTOTAL=0 F SUM=6:1:20 S NIHTOTAL=NIHTOTAL+$P($G(VFSTR),U,SUM)
..S @FDA@(.19)=NIHTOTAL ;.19
..N COMCODE,COMSTR,ZI D ;check for NIH comment fields
...;F ZI=1:1:$P(INP(0),U,2) D
...F ZI=VI+1:1:VI+4 D
....S COMSTR=$G(INP(ZI)) Q:COMSTR=""
....S COMCODE=$P(COMSTR,U)
....I COMCODE="MA" D
.....S VFCOMM=$P(COMSTR,U,3) ;1.01
.....S @FDA@(1.01)=$S(VFCOMM="":"@",1:VFCOMM)
.....S VFCOMM=$P(COMSTR,U,4) ;1.02
.....S @FDA@(1.02)=$S(VFCOMM="":"@",1:VFCOMM)
....I COMCODE="ML" D
.....S VFCOMM=$P(COMSTR,U,3) ;2.01
.....S @FDA@(2.01)=$S(VFCOMM="":"@",1:VFCOMM)
.....S VFCOMM=$P(COMSTR,U,4) ;2.02
.....S @FDA@(2.02)=$S(VFCOMM="":"@",1:VFCOMM)
....I COMCODE="LA" D
.....S VFCOMM=$P(COMSTR,U,3) ;3.01
.....S @FDA@(3.01)=$S(VFCOMM="":"@",1:VFCOMM)
....I COMCODE="DY" D
.....S VFCOMM=$P(COMSTR,U,3) ;3.02
.....S @FDA@(3.02)=$S(VFCOMM="":"@",1:VFCOMM)
.E I VCODE="P" D ; Protocol Standing Orders (Sub-File)
..S SUBIEN=$P(VFSTR,U,2)
..I $G(SUBIEN)]"" Q:'$D(^AUPNVSTR(VFIEN,13,+SUBIEN))
..I SUBIEN["@" N NODE S NODE=",13," D DMULT^BGOVSTR1(RET,VFIEN,SUBIEN,NODE) Q
..I SUBIEN="" S NUMNEW=$G(NUMNEW)+1,SUBIEN="+"_NUMNEW
..S SUBIEN=SUBIEN_","_VFIEN_","
..S FDA=$NA(FDA(FNUM_13,SUBIEN))
..S @FDA@(.01)=$P(VFSTR,U,3)
..S @FDA@(.02)=$P(VFSTR,U,4)
..S:@FDA@(.02)'=""&(@FDA@(.02)'[".") @FDA@(.02)=@FDA@(.02)-1+.24
..S @FDA@(.03)=NOW
..S @FDA@(.04)=DUZ
.E I VCODE="PT" D ;
..Q:+SUBIEN&(SUBIEN["@")
..S VFCOMM=$P(VFSTR,U,3)
..I VFCOMM="" S @FDA@(1)="@"
..E D
...S @FDA@(1)=$NA(FDA(FNUM_13,SUBIEN,1))
...S @FDA@(1,0)=$G(@FDA@(1,0))+1
...S @FDA@(1,@FDA@(1,0))=VFCOMM
.E I VCODE="SS" D
..S SUBIEN=$P(VFSTR,U,2)
..I $G(SUBIEN)]"" Q:'$D(^AUPNVSTR(VFIEN,14,+SUBIEN))
..I SUBIEN["@" N NODE S NODE=",14," D DMULT^BGOVSTR1(RET,VFIEN,SUBIEN,NODE) Q
..I SUBIEN="" S NUMNEW=$G(NUMNEW)+1,SUBIEN="+"_NUMNEW
..S SUBIEN=SUBIEN_","_VFIEN_","
..S FDA=$NA(FDA(FNUM_14,SUBIEN))
..S @FDA@(.01)=$P(VFSTR,U,4) ;Concept ID
..S (DESCT,@FDA@(.02))=$P(VFSTR,U,3) ;Description ID
..S NARR=""
..I DESCT]"" S NARRPTR=$$NARR^BGOVSTR1(DESCT,NARR)
..S @FDA@(.03)=$S($G(NARRPTR)>0:NARRPTR,1:"")
..S @FDA@(.06)=$P(VFSTR,U,6) ;Witnessed?
..S @FDA@(.07)=$P(VFSTR,U,7) ;Witnessed By
..S:@FDA@(.07)="" @FDA@(.07)="@"
..S @FDA@(.08)=$P(VFSTR,U,8) ;Date/Time Witnessed
..I @FDA@(.08)="" S @FDA@(.08)="@"
..E S:@FDA@(.08)'["." @FDA@(.08)=@FDA@(.08)-1+.24
..I $P(VFSTR,U,6)=1 I $P(VFSTR,U,8)="" S @FDA@(.08)=NOW
..S @FDA@(.09)=$P(VFSTR,U,9) ;Baseline State LOINC
..S @FDA@(.1)=$P(VFSTR,U,10) ;Baseline State Date/Time
..S:@FDA@(.1)'=""&(@FDA@(.1)'[".") @FDA@(.1)=@FDA@(.1)-1+.24
..S @FDA@(.04)=NOW ; Date/Time Entered
..S @FDA@(.05)=DUZ ; Entered By
.E I VCODE="ST" D
..Q:+SUBIEN&(SUBIEN["@")
..S VFCOMM=$P(VFSTR,U,3)
..I VFCOMM="" S @FDA@(1)="@"
..E D
...S @FDA@(1)=$NA(FDA(FNUM_14,SUBIEN,1))
...S @FDA@(1,0)=$G(@FDA@(1,0))+1
...S @FDA@(1,@FDA@(1,0))=VFCOMM
S RET=$$UPDATE^BGOUTL(.FDA,"")
I RET,VFNEW,$$DELETE^BGOUTL(FNUM,VFIEN) Q RET
D:'RET VFEVT^BGOUTL2(FNUM,VFIEN,'VFNEW)
S:'RET RET=VFIEN
;Patient Refusals for Service/NMI entry:
I $G(REFUSED)]"" N RET S RET=$$SETREF^BGOVSTR1(DFN,REFUSED,REFDT,VFNEW)
;V Measurement LKW entry:
I $G(BASELINE)]"" D
.N RET1,RET2,LKW
.S LKW=$$GET1^DIQ(9000010.63,VFIEN,1601,"I")
.S RET1=$$SETLKW^BGOVSTR1(DFN_U_VIEN_U_BASELINE_U_LKW)
.I +RET1 D
..N FDA
..S FDA=$NA(FDA(FNUM,VFIEN_","))
..S @FDA@(1601)=RET1
..S RET2=$$UPDATE^BGOUTL(.FDA,"")
;V Measurement NIH entry:
I $G(NIHTOTAL)]"" D
.N RET1 S RET1=$$SETNIH^BGOVSTR1(VFIEN,VIEN,.INP)
Q RET
DEL(RET,IEN,SUBIEN) ;EP Delete the subfield
N ERR,DA,DIK,NODE,VMIEN
S ERR=""
S VMIEN=$$GET1^DIQ(9000010.6315,SUBIEN_","_IEN_",",.2,"I")
S NODE=15
S DA(1)=IEN,DA=SUBIEN
S DIK="^AUPNVSTR(DA(1),"_NODE_","
S:DA ERR=$$DELETE^BGOUTL(DIK,.DA)
I ERR'="" S RET=RET_"^"_ERR
D STRDEL^BGOVSTR1(VMIEN)
Q
; Return V File #
FNUM(RET,INP) S RET=9000010.63
Q RET
BGOVSTR2 ; MSC/JS - Utility calls for V STROKE ;12-Nov-2014 14:03;PLS
+1 ;;1.1;BGO COMPONENTS;**13,14**;Mar 20, 2007
+2 ;01.24.14 - MSC/JS - move SET here to keep within 15k routine size limits
+3 ;02.06.14 - MSC/MGH Changed field .17 to store text
+4 ;05.01.14 - MSC/DKA Allow neither Fib Init nor Fib Not Init.
+5 ;
+6 ;Add/edit V STROKE entry
SET(RET,INP) ;EP
+1 ; INP is an array of strings.
+2 ; The first string is the VFIEN^NumberOfLines^VisitIsLocked
+3 ; Each subsequent string is prefixed with a letter indicating the type of record:
+4 ; A - Arrival
+5 ; AT - Arrival Text (Comment)
+6 ; F - Fibrinolytic Therapy
+7 ; FT - Fibrinolytic Therapy Text (Comment)
+8 ; N - NIH Stroke Scale (Multiple)
+9 ; P - Protocol Standing Orders (Multiple)
+10 ; PT - Standing Order Comment (Multiple)
+11 ; SS - Stroke Symptoms (Multiple)
+12 ; ST - Stroke Symptoms EKG Findings Comment (Multiple)
+13 ; MA - NIH Motor Arm Comments
+14 ; ML - NIH Motor Limb Comments
+15 ; LA - NIH Limb Ataxia Comment
+16 ; DY - NIH Dysarthria Comment
+17 NEW BASELINE,DESCT,I,FDA,FNUM,NI,NIHDATE,NIHTOTAL,NOW,NUMNEW,NARR,NARRPTR,REFUSED,AARDT,EVTDT,EVTSTR,FIBTXT,REFDT,DFN
+18 NEW QIEN,DEL,QUAL,QUALS,SNOMED,SUBIEN,SUM,TYPE,VCODE,VFIEN,VFLDERR,VFNEW,VFSTR,VI,VIEN,VMIEN,VMINP,VISDAT,ARRDT,VFCOMM,VFVAL,FI
+19 SET RET=""
SET FNUM=$$FNUM
+20 SET VFIEN=+INP(0)
+21 SET VFNEW='VFIEN
+22 SET VIEN=$PIECE(INP(1),U,4)
+23 SET VISDAT=$GET(^AUPNVSIT(VIEN,0))
+24 SET DFN=$PIECE(VISDAT,U,5)
+25 IF $GET(DFN)=""
SET RET=$$ERR^BGOUTL(1062)
QUIT
+26 ; Use the same value for Date/Time Entered fields
SET NOW=$$NOW^XLFDT
+27 SET RET=$$CHKVISIT^BGOUTL(VIEN)
IF RET
QUIT
+28 IF VFNEW
IF VFIEN=0
SET VFIEN=NOW
+29 IF VFNEW
DO VFNEW^BGOUTL2(.RET,FNUM,VFIEN,VIEN)
IF RET>0
SET VFIEN=RET
SET RET=""
+30 IF 'VFIEN
SET RET=$$ERR^BGOUTL(1070)
QUIT
+31 SET FDA=$NAME(FDA(FNUM,VFIEN_","))
+32 FOR VI=1:1:$PIECE(INP(0),U,2)
Begin DoDot:1
+33 SET VFSTR=$GET(INP(VI))
IF VFSTR=""
QUIT
+34 SET VCODE=$PIECE(VFSTR,U)
+35 IF VCODE="A"
Begin DoDot:2
+36 SET FDA=$NAME(FDA(FNUM,VFIEN_","))
+37 SET ARRDT=$PIECE(VFSTR,U,2)
+38 IF ARRDT>0
IF ARRDT'["."
SET ARRDT=(ARRDT-1)+.24
+39 ;ArrivalDateTime
SET @FDA@(.01)=ARRDT
+40 ;Handedness
SET @FDA@(.04)=$PIECE(VFSTR,U,3)
+41 ;Clinic
SET @FDA@(1203)=$$GET1^DIQ(44,$PIECE(VFSTR,U,5),8,"I")
+42 ;EncounterProvider
SET @FDA@(1204)=$PIECE(VFSTR,U,6)
+43 SET EVTDT=$PIECE(VFSTR,U,7)
+44 IF EVTDT>0
IF EVTDT'["."
SET EVTDT=(EVTDT-1)+.24
+45 ;EventDateTime
SET @FDA@(1201)=EVTDT
+46 SET BASELINE=EVTDT
End DoDot:2
+47 IF '$TEST
IF VCODE="AT"
Begin DoDot:2
+48 SET FDA=$NAME(FDA(FNUM,VFIEN_","))
+49 ; Comment (Date/Time Arrival)
SET VFCOMM=$PIECE(VFSTR,U,2)
+50 ; Delete the comment, whether or not it already exists.
IF VFCOMM=""
SET @FDA@(1)="@"
+51 IF '$TEST
Begin DoDot:3
+52 SET @FDA@(1)=$NAME(FDA(FNUM,VFIEN_",",1))
+53 SET @FDA@(1,0)=$GET(@FDA@(1,0))+1
+54 SET @FDA@(1,@FDA@(1,0))=VFCOMM
End DoDot:3
End DoDot:2
+55 IF '$TEST
IF VCODE="F"
Begin DoDot:2
+56 ; 2014-05-01 DKA If no date is sent, then clear both FibInit and FibNotInit fields,
+57 ; else if a reason is not sent, set FibInit and clear FibNotInit fields,
+58 ; otherwise set FibNotInit and clear FibInit fields.
+59 SET FDA=$NAME(FDA(FNUM,VFIEN_","))
+60 ;First check to see if neither FT Initiated nor FT Not Initiated (None button checked)
+61 ; Clear all the FibInit and FibNotInit fields
IF $PIECE(VFSTR,U,2,3)=U
FOR FI=.11:.01:.17
SET @FDA@(FI)="@"
+62 IF '$TEST
IF $PIECE(VFSTR,U,4)=""
Begin DoDot:3
+63 ; FT Initiated
+64 ;FibrinolyticTherapyInitiated
SET @FDA@(.11)=$PIECE(VFSTR,U,2)
+65 IF @FDA@(.11)'=""&(@FDA@(.11)'[".")
SET @FDA@(.11)=@FDA@(.11)-1+.24
+66 SET @FDA@(.12)=NOW
SET @FDA@(.13)=DUZ
+67 SET @FDA@(.14)="@"
+68 SET @FDA@(.15)="@"
+69 SET @FDA@(.16)="@"
+70 SET @FDA@(.17)="@"
+71 ;IHS/MSC/MGH Try to remove any refusal reason if this is an edit
+72 DO DELREF^BGOVSTR1(VFIEN)
End DoDot:3
+73 IF '$TEST
Begin DoDot:3
+74 ; FT Not Initiated
+75 ;DidNotInit
SET (@FDA@(.14),REFDT)=$PIECE(VFSTR,U,3)
+76 IF @FDA@(.14)'=""&(@FDA@(.14)'[".")
SET @FDA@(.14)=@FDA@(.14)-1+.24
+77 SET @FDA@(.15)=NOW
SET @FDA@(.16)=DUZ
+78 ;S (@FDA@(.17),REFUSED)=$P(VFSTR,U,4) ;DidnotInitReason
+79 SET REFUSED=$PIECE(VFSTR,U,4)
+80 SET FIBTXT=$$GET1^DIQ(9999999.102,REFUSED,.01)
+81 SET @FDA@(.17)=FIBTXT
+82 SET @FDA@(.11)="@"
+83 SET @FDA@(.12)="@"
+84 SET @FDA@(.13)="@"
End DoDot:3
End DoDot:2
+85 IF '$TEST
IF VCODE="FT"
Begin DoDot:2
+86 SET FDA=$NAME(FDA(FNUM,VFIEN_","))
+87 ; Fibrinolytic Therapy Comment
SET VFCOMM=$PIECE(VFSTR,U,2)
+88 ; Delete the comment, whether or not it already exists.
IF VFCOMM=""
SET @FDA@(4)="@"
+89 IF '$TEST
Begin DoDot:3
+90 SET @FDA@(4)=$NAME(FDA(FNUM,VFIEN_",",4))
+91 SET @FDA@(4,0)=$GET(@FDA@(4,0))+1
+92 SET @FDA@(4,@FDA@(4,0))=VFCOMM
End DoDot:3
End DoDot:2
+93 ;NIH Stroke Scale (Multiple-9000010.6315), [15;0]
IF '$TEST
IF VCODE="N"
Begin DoDot:2
+94 SET SUBIEN=$PIECE(VFSTR,U,2)
+95 IF $GET(SUBIEN)]""
IF '$DATA(^AUPNVSTR(VFIEN,15,+SUBIEN))
QUIT
+96 ;Delete flag
SET DEL=$PIECE(VFSTR,U,5)
+97 IF +SUBIEN&(DEL="@")
DO DEL(RET,VFIEN,SUBIEN)
QUIT
+98 IF SUBIEN=""
SET NUMNEW=$GET(NUMNEW)+1
SET SUBIEN="+"_NUMNEW
+99 SET SUBIEN=SUBIEN_","_VFIEN_","
+100 SET FDA=$NAME(FDA(FNUM_15,SUBIEN))
+101 ;$p3 = .01 field (DateTime)
+102 SET @FDA@(.01)=$SELECT($PIECE(VFSTR,U,3)>0:$PIECE(VFSTR,U,3),1:NOW)
+103 IF @FDA@(.01)'=""&(@FDA@(.01)'[".")
SET @FDA@(.01)=@FDA@(.01)-1+.24
+104 ;.02
SET @FDA@(.02)=$PIECE(VFSTR,U,4)
+105 IF @FDA@(.02)'=""&(@FDA@(.02)'[".")
SET @FDA@(.02)=@FDA@(.02)-1+.24
+106 ;.03
SET @FDA@(.03)=DUZ
+107 ;.04
SET VFVAL=$PIECE(VFSTR,U,6)
SET @FDA@(.04)=$SELECT(VFVAL="":"@",1:VFVAL)
+108 ;.05
SET VFVAL=$PIECE(VFSTR,U,7)
SET @FDA@(.05)=$SELECT(VFVAL="":"@",1:VFVAL)
+109 ;.06
SET VFVAL=$PIECE(VFSTR,U,8)
SET @FDA@(.06)=$SELECT(VFVAL="":"@",1:VFVAL)
+110 ;.07
SET VFVAL=$PIECE(VFSTR,U,9)
SET @FDA@(.07)=$SELECT(VFVAL="":"@",1:VFVAL)
+111 ;.08
SET VFVAL=$PIECE(VFSTR,U,10)
SET @FDA@(.08)=$SELECT(VFVAL="":"@",1:VFVAL)
+112 ;.09
SET VFVAL=$PIECE(VFSTR,U,11)
SET @FDA@(.09)=$SELECT(VFVAL="":"@",1:VFVAL)
+113 ;.1
SET VFVAL=$PIECE(VFSTR,U,12)
SET @FDA@(.1)=$SELECT(VFVAL="":"@",1:VFVAL)
+114 ;.11
SET VFVAL=$PIECE(VFSTR,U,13)
SET @FDA@(.11)=$SELECT(VFVAL="":"@",1:VFVAL)
+115 ;.12
SET VFVAL=$PIECE(VFSTR,U,14)
SET @FDA@(.12)=$SELECT(VFVAL="":"@",1:VFVAL)
+116 ;.13
SET VFVAL=$PIECE(VFSTR,U,15)
SET @FDA@(.13)=$SELECT(VFVAL="":"@",1:VFVAL)
+117 ;.14
SET VFVAL=$PIECE(VFSTR,U,16)
SET @FDA@(.14)=$SELECT(VFVAL="":"@",1:VFVAL)
+118 ;.15
SET VFVAL=$PIECE(VFSTR,U,17)
SET @FDA@(.15)=$SELECT(VFVAL="":"@",1:VFVAL)
+119 ;.16
SET VFVAL=$PIECE(VFSTR,U,18)
SET @FDA@(.16)=$SELECT(VFVAL="":"@",1:VFVAL)
+120 ;.17
SET VFVAL=$PIECE(VFSTR,U,19)
SET @FDA@(.17)=$SELECT(VFVAL="":"@",1:VFVAL)
+121 ;.18
SET VFVAL=$PIECE(VFSTR,U,20)
SET @FDA@(.18)=$SELECT(VFVAL="":"@",1:VFVAL)
+122 SET NIHTOTAL=0
FOR SUM=6:1:20
SET NIHTOTAL=NIHTOTAL+$PIECE($GET(VFSTR),U,SUM)
+123 ;.19
SET @FDA@(.19)=NIHTOTAL
+124 ;check for NIH comment fields
NEW COMCODE,COMSTR,ZI
Begin DoDot:3
+125 ;F ZI=1:1:$P(INP(0),U,2) D
+126 FOR ZI=VI+1:1:VI+4
Begin DoDot:4
+127 SET COMSTR=$GET(INP(ZI))
IF COMSTR=""
QUIT
+128 SET COMCODE=$PIECE(COMSTR,U)
+129 IF COMCODE="MA"
Begin DoDot:5
+130 ;1.01
SET VFCOMM=$PIECE(COMSTR,U,3)
+131 SET @FDA@(1.01)=$SELECT(VFCOMM="":"@",1:VFCOMM)
+132 ;1.02
SET VFCOMM=$PIECE(COMSTR,U,4)
+133 SET @FDA@(1.02)=$SELECT(VFCOMM="":"@",1:VFCOMM)
End DoDot:5
+134 IF COMCODE="ML"
Begin DoDot:5
+135 ;2.01
SET VFCOMM=$PIECE(COMSTR,U,3)
+136 SET @FDA@(2.01)=$SELECT(VFCOMM="":"@",1:VFCOMM)
+137 ;2.02
SET VFCOMM=$PIECE(COMSTR,U,4)
+138 SET @FDA@(2.02)=$SELECT(VFCOMM="":"@",1:VFCOMM)
End DoDot:5
+139 IF COMCODE="LA"
Begin DoDot:5
+140 ;3.01
SET VFCOMM=$PIECE(COMSTR,U,3)
+141 SET @FDA@(3.01)=$SELECT(VFCOMM="":"@",1:VFCOMM)
End DoDot:5
+142 IF COMCODE="DY"
Begin DoDot:5
+143 ;3.02
SET VFCOMM=$PIECE(COMSTR,U,3)
+144 SET @FDA@(3.02)=$SELECT(VFCOMM="":"@",1:VFCOMM)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+145 ; Protocol Standing Orders (Sub-File)
IF '$TEST
IF VCODE="P"
Begin DoDot:2
+146 SET SUBIEN=$PIECE(VFSTR,U,2)
+147 IF $GET(SUBIEN)]""
IF '$DATA(^AUPNVSTR(VFIEN,13,+SUBIEN))
QUIT
+148 IF SUBIEN["@"
NEW NODE
SET NODE=",13,"
DO DMULT^BGOVSTR1(RET,VFIEN,SUBIEN,NODE)
QUIT
+149 IF SUBIEN=""
SET NUMNEW=$GET(NUMNEW)+1
SET SUBIEN="+"_NUMNEW
+150 SET SUBIEN=SUBIEN_","_VFIEN_","
+151 SET FDA=$NAME(FDA(FNUM_13,SUBIEN))
+152 SET @FDA@(.01)=$PIECE(VFSTR,U,3)
+153 SET @FDA@(.02)=$PIECE(VFSTR,U,4)
+154 IF @FDA@(.02)'=""&(@FDA@(.02)'[".")
SET @FDA@(.02)=@FDA@(.02)-1+.24
+155 SET @FDA@(.03)=NOW
+156 SET @FDA@(.04)=DUZ
End DoDot:2
+157 ;
IF '$TEST
IF VCODE="PT"
Begin DoDot:2
+158 IF +SUBIEN&(SUBIEN["@")
QUIT
+159 SET VFCOMM=$PIECE(VFSTR,U,3)
+160 IF VFCOMM=""
SET @FDA@(1)="@"
+161 IF '$TEST
Begin DoDot:3
+162 SET @FDA@(1)=$NAME(FDA(FNUM_13,SUBIEN,1))
+163 SET @FDA@(1,0)=$GET(@FDA@(1,0))+1
+164 SET @FDA@(1,@FDA@(1,0))=VFCOMM
End DoDot:3
End DoDot:2
+165 IF '$TEST
IF VCODE="SS"
Begin DoDot:2
+166 SET SUBIEN=$PIECE(VFSTR,U,2)
+167 IF $GET(SUBIEN)]""
IF '$DATA(^AUPNVSTR(VFIEN,14,+SUBIEN))
QUIT
+168 IF SUBIEN["@"
NEW NODE
SET NODE=",14,"
DO DMULT^BGOVSTR1(RET,VFIEN,SUBIEN,NODE)
QUIT
+169 IF SUBIEN=""
SET NUMNEW=$GET(NUMNEW)+1
SET SUBIEN="+"_NUMNEW
+170 SET SUBIEN=SUBIEN_","_VFIEN_","
+171 SET FDA=$NAME(FDA(FNUM_14,SUBIEN))
+172 ;Concept ID
SET @FDA@(.01)=$PIECE(VFSTR,U,4)
+173 ;Description ID
SET (DESCT,@FDA@(.02))=$PIECE(VFSTR,U,3)
+174 SET NARR=""
+175 IF DESCT]""
SET NARRPTR=$$NARR^BGOVSTR1(DESCT,NARR)
+176 SET @FDA@(.03)=$SELECT($GET(NARRPTR)>0:NARRPTR,1:"")
+177 ;Witnessed?
SET @FDA@(.06)=$PIECE(VFSTR,U,6)
+178 ;Witnessed By
SET @FDA@(.07)=$PIECE(VFSTR,U,7)
+179 IF @FDA@(.07)=""
SET @FDA@(.07)="@"
+180 ;Date/Time Witnessed
SET @FDA@(.08)=$PIECE(VFSTR,U,8)
+181 IF @FDA@(.08)=""
SET @FDA@(.08)="@"
+182 IF '$TEST
IF @FDA@(.08)'["."
SET @FDA@(.08)=@FDA@(.08)-1+.24
+183 IF $PIECE(VFSTR,U,6)=1
IF $PIECE(VFSTR,U,8)=""
SET @FDA@(.08)=NOW
+184 ;Baseline State LOINC
SET @FDA@(.09)=$PIECE(VFSTR,U,9)
+185 ;Baseline State Date/Time
SET @FDA@(.1)=$PIECE(VFSTR,U,10)
+186 IF @FDA@(.1)'=""&(@FDA@(.1)'[".")
SET @FDA@(.1)=@FDA@(.1)-1+.24
+187 ; Date/Time Entered
SET @FDA@(.04)=NOW
+188 ; Entered By
SET @FDA@(.05)=DUZ
End DoDot:2
+189 IF '$TEST
IF VCODE="ST"
Begin DoDot:2
+190 IF +SUBIEN&(SUBIEN["@")
QUIT
+191 SET VFCOMM=$PIECE(VFSTR,U,3)
+192 IF VFCOMM=""
SET @FDA@(1)="@"
+193 IF '$TEST
Begin DoDot:3
+194 SET @FDA@(1)=$NAME(FDA(FNUM_14,SUBIEN,1))
+195 SET @FDA@(1,0)=$GET(@FDA@(1,0))+1
+196 SET @FDA@(1,@FDA@(1,0))=VFCOMM
End DoDot:3
End DoDot:2
End DoDot:1
+197 SET RET=$$UPDATE^BGOUTL(.FDA,"")
+198 IF RET
IF VFNEW
IF $$DELETE^BGOUTL(FNUM,VFIEN)
QUIT RET
+199 IF 'RET
DO VFEVT^BGOUTL2(FNUM,VFIEN,'VFNEW)
+200 IF 'RET
SET RET=VFIEN
+201 ;Patient Refusals for Service/NMI entry:
+202 IF $GET(REFUSED)]""
NEW RET
SET RET=$$SETREF^BGOVSTR1(DFN,REFUSED,REFDT,VFNEW)
+203 ;V Measurement LKW entry:
+204 IF $GET(BASELINE)]""
Begin DoDot:1
+205 NEW RET1,RET2,LKW
+206 SET LKW=$$GET1^DIQ(9000010.63,VFIEN,1601,"I")
+207 SET RET1=$$SETLKW^BGOVSTR1(DFN_U_VIEN_U_BASELINE_U_LKW)
+208 IF +RET1
Begin DoDot:2
+209 NEW FDA
+210 SET FDA=$NAME(FDA(FNUM,VFIEN_","))
+211 SET @FDA@(1601)=RET1
+212 SET RET2=$$UPDATE^BGOUTL(.FDA,"")
End DoDot:2
End DoDot:1
+213 ;V Measurement NIH entry:
+214 IF $GET(NIHTOTAL)]""
Begin DoDot:1
+215 NEW RET1
SET RET1=$$SETNIH^BGOVSTR1(VFIEN,VIEN,.INP)
End DoDot:1
+216 QUIT RET
DEL(RET,IEN,SUBIEN) ;EP Delete the subfield
+1 NEW ERR,DA,DIK,NODE,VMIEN
+2 SET ERR=""
+3 SET VMIEN=$$GET1^DIQ(9000010.6315,SUBIEN_","_IEN_",",.2,"I")
+4 SET NODE=15
+5 SET DA(1)=IEN
SET DA=SUBIEN
+6 SET DIK="^AUPNVSTR(DA(1),"_NODE_","
+7 IF DA
SET ERR=$$DELETE^BGOUTL(DIK,.DA)
+8 IF ERR'=""
SET RET=RET_"^"_ERR
+9 DO STRDEL^BGOVSTR1(VMIEN)
+10 QUIT
+11 ; Return V File #
FNUM(RET,INP) SET RET=9000010.63
+1 QUIT RET
