Routine: BGOVSTR2

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)

 ; 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

BGOVSTR2.m