BGOVAMI2.m

BGOVAMI2 ; IHS/MSC/DKA - AMI Utilities 2 ;11-Jun-2018 13:08;DU

 ;;1.1;BGO COMPONENTS;**13,14,24**;Mar 20, 2007;Build 1

 ;01.23.14 - MSC/JS - move SET here to keep within 15k routine size limits

 ;01.28.14 - DEBUG EVENT CALL FOR NEW AMI RECORD ADDED

 ;O2.06.14 - Field .17 changed to store text

 ;05.01.14 - MSC/DKA Allow neither Fib Init nor Fib Not Init.

 ;

 ; Add/edit V AMI entry

SET(RET,INP) ;EP

 ; This is the exact opposite of the GET call.

 ; 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)

 ; E   - EKG Done

 ; EF  - EKG Findings (Multiple)

 ; EFT - EKG Findings Text (Comment)

 ; ET  - EKG Done Text (Comment)

 ; F   - Fibrinolytic Therapy

 ; FT  - Fibrinolytic Therapy Text (Comment)

 ; O   - Onset Symptoms

 ; OT  - Onset Symptoms Text (Comment)

 ; P   - Protocol Standing Order

 ; PT  - Protocol Standing Order Text (Comment)

 ; S   - Symptom

 ; PC  - PCI data

 N DESCT,FDA,FNUM,NARR,NARRPTR,NOW,NUMNEW,SUBIEN,VCODE,VFIEN,VFNEW,VFSTR,VI,VIEN,REFUSED,VISDAT,DELF,VFCOMM

 N ADT,EDT,FDT,ODT,PDT,ATCOMM,EFTCOMM,ETCOMM,FTCOMM,OTCOMM,PTCOMM,FIBTXT,REFDT,DFN,RET2,FI,SNO

 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  ; Visit does not exist

 I VFNEW D VFNEW^BGOUTL2(.RET,FNUM,VFIEN,VIEN) S:RET>0 VFIEN=RET,RET=""

 I 'VFIEN S RET=$$ERR^BGOUTL(1070) Q  ; Unknown file entry (Best match for Unable to Add V File Entry)

 S FDA=$NA(FDA(FNUM,VFIEN_","))

 F VI=1:1:$P(INP(0),U,2) D

 .S VFSTR=INP(VI)

 .S VCODE=$P(VFSTR,U)

 .I VCODE="A" D

 ..S FDA=$NA(FDA(FNUM,VFIEN_","))

 ..S ADT=$P(VFSTR,U,2)

 ..I ADT>0,ADT'["." S ADT=(ADT-1)+.24

 ..S @FDA@(.01)=ADT ;ArrivalDateTime

 ..;S @FDA@(.01)=$P(VFSTR,U,2) ;ArrivalDateTime

 ..S @FDA@(1204)=$P(VFSTR,U,5) ;EncounterProvider

 .E  I VCODE="AT" D

 ..S FDA=$NA(FDA(FNUM,VFIEN_","))

 ..S ATCOMM=$P(VFSTR,U,2) ; Comment (Date/Time Arrival)

 ..I ATCOMM="" 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))=ATCOMM

 .E  I VCODE="E" D

 ..S FDA=$NA(FDA(FNUM,VFIEN_","))

 ..S SNO=$$GET^XPAR("ALL","BGO EKG DONE SNOMED",1,"E")

 ..I $P(VFSTR,U,2)]"" D

 ...S EDT=$P(VFSTR,U,2)

 ...I EDT>0,EDT'["." S EDT=(EDT-1)+.24

 ...S @FDA@(.07)=EDT ;EKGDone(Date/Time)

 ...;S @FDA@(.07)=$P(VFSTR,U,2) ;EKGDoneDateTime

 ...S @FDA@(.08)=NOW

 ...S @FDA@(.09)=DUZ

 ...S @FDA@(1201)=$P(VFSTR,U,3) ;EventDateTime

 ...S @FDA@(1202)=$P(VFSTR,U,4) ;OrderingProvider

 ...S @FDA@(1210)=$P(VFSTR,U,5) ;OutsideProviderName

 ...S @FDA@(1215)=$P(VFSTR,U,6) ;OrderingLocation

 ...I EDT>0 S @FDA@(1101)=SNO ;EKG done SNOMED term Patch 24

 ..I $P(VFSTR,U,2)="" D  ;                             1.22.14

 ...S @FDA@(.07)="@" ;EKGDone(Date/Time)

 ...S @FDA@(.08)="@" ;EKGDateTimeEntered

 ...S @FDA@(.09)="@" ;EKGEnteredBy

 ...S @FDA@(1201)="@" ;EventDateTime

 ...S @FDA@(1202)="@" ;OrderingProvider

 ...S @FDA@(1210)="@" ;OutsideProviderName

 ...S @FDA@(1215)="@" ;OrderingLocation

 ...S @FDA@(1101)="@" ;EKG done code patch 24

 ...S @FDA@(3)="@" ;EKG Comment [ET]

 .E  I VCODE="EF" D

 ..S SUBIEN=$P(VFSTR,U,2)

 ..I +SUBIEN&(SUBIEN["@") D DEL^BGOVAMI1(.RET2,VFIEN,SUBIEN,14) 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,3) ;EkgFindingsConceptId

 ..S (DESCT,@FDA@(.02))=$P(VFSTR,U,4) ;Description ID

 ..S (NARR,@FDA@(.03))=$P(VFSTR,U,5) ;Provider Text

 ..I DESCT]"" I NARR]"" S NARRPTR=$$NARR(DESCT,NARR)

 ..S @FDA@(.03)=$S($G(NARRPTR)>0:NARRPTR,1:"")

 ..S @FDA@(.04)=$P(VFSTR,U,6) ;ICD-9

 ..S @FDA@(.06)=$P(VFSTR,U,7) ;Interpreted By

 ..S @FDA@(.07)=$P(VFSTR,U,8) ;Event Date/Time

 ..S @FDA@(.08)=NOW ; Date/Time Entered

 ..S @FDA@(.09)=DUZ ; Entered By

 .E  I VCODE="EFT" D  ; Use same SUBIEN as previous "EF" record

 ..Q:+SUBIEN&(SUBIEN["@")

 ..S EFTCOMM=$P(VFSTR,U,3)

 ..I EFTCOMM="" 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))=EFTCOMM

 .E  I VCODE="ET" D

 ..S FDA=$NA(FDA(FNUM,VFIEN_","))

 ..S ETCOMM=$P(VFSTR,U,2) ; EKG Comment

 ..I ETCOMM="" S @FDA@(3)="@"

 ..E  D

 ...S @FDA@(3)=$NA(FDA(FNUM,VFIEN_",",3))

 ...S @FDA@(3,0)=$G(@FDA@(3,0))+1

 ...S @FDA@(3,@FDA@(3,0))=ETCOMM

 .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  ;  $P4 = Did Not Init Fib Reason  fld#.17

 ...; FT Initiated

 ...S FDT=$P(VFSTR,U,2)

 ...I FDT>0,FDT'["." S FDT=(FDT-1)+.24

 ...S @FDA@(.11)=FDT ;FibrinolyticTherapyInitiated

 ...;S @FDA@(.11)=$P(VFSTR,U,2) ;FibrinolyticTherapyInitiated

 ...S @FDA@(.12)=NOW,@FDA@(.13)=DUZ

 ...S @FDA@(.14)="@" ; Delete any previous value for FT DidNotInit

 ...S @FDA@(.15)="@" ; Delete any previous value for FT DidNotInitD/TEntered

 ...S @FDA@(.16)="@" ; Delete any previous value for FT DidNotInitEnteredBy

 ...S @FDA@(.17)="@" ; Delete any previous value for FT DidnotInitReason

 ...;IHS/MSC/MGH Try to remove any refusal reason if this is an edit

 ...D DELREF^BGOVAMI1(VFIEN)

 ..E  D

 ...; FT Not Initiated

 ...S (@FDA@(.14),REFDT)=$P(VFSTR,U,3) ;DidNotInit (Date)

 ...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)="@" ; Delete any previous value for FT Initiated

 ...S @FDA@(.12)="@" ; Delete any previous value for FT D/TEntered

 ...S @FDA@(.13)="@" ; Delete any previous value for FT EnteredBy

 .E  I VCODE="FT" D

 ..S FDA=$NA(FDA(FNUM,VFIEN_","))

 ..S FTCOMM=$P(VFSTR,U,2) ; Fibrinolytic Therapy Comment

 ..I FTCOMM="" 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))=FTCOMM

 .;IHS/MSC/MGH Patch 24 for PCI

 .E  I VCODE="PC" D

 ..S FDA=$NA(FDA(FNUM,VFIEN_","))

 ..I $P(VFSTR,U,2)="" D

 ...S @FDA@(1102)="@"

 ...S @FDA@(1103)="@"

 ..E  D

 ...S @FDA@(1102)=$P(VFSTR,U,2)

 ...I $P(VFSTR,U,3)="" S @FDA@(1103)="@"

 ...E  S @FDA@(1103)=$P(VFSTR,U,3)

 .E  I VCODE="O" D

 ..S FDA=$NA(FDA(FNUM,VFIEN_","))

 ..S ODT=$P(VFSTR,U,2)

 ..I ODT>0,ODT'["." S ODT=(ODT-1)+.24

 ..S @FDA@(.04)=ODT ;OnsetSymptoms

 ..;S @FDA@(.04)=$P(VFSTR,U,2) ;OnsetSymptoms

 ..S @FDA@(.05)=NOW

 ..S @FDA@(.06)=DUZ

 .E  I VCODE="OT" D

 ..S FDA=$NA(FDA(FNUM,VFIEN_","))

 ..S @FDA@(2)=$NA(FDA(FNUM,VFIEN_",",2))

 ..S OTCOMM=$P(VFSTR,U,2) ; Onset Symptoms Text

 ..I OTCOMM="" S @FDA@(2)="@" ; Delete the comment, whether or not it already exists.

 ..E  D

 ...S @FDA@(2)=$NA(FDA(FNUM,VFIEN_",",2))

 ...S @FDA@(2,0)=$G(@FDA@(2,0))+1

 ...S @FDA@(2,@FDA@(2,0))=OTCOMM

 .E  I VCODE="P" D  ; Protocol Standing Orders (Sub-File)

 ..S SUBIEN=$P(VFSTR,U,2)

 ..I +SUBIEN&(SUBIEN["@") D DEL^BGOVAMI1(.RET2,VFIEN,SUBIEN,13) 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 PDT=$P(VFSTR,U,4)

 ..I PDT>0,PDT'["." S PDT=(PDT-1)+.24

 ..S @FDA@(.02)=PDT ;ProtocolEventDateTime

 ..;S @FDA@(.02)=$P(VFSTR,U,4) ;ProtocolEventDateTime

 ..S @FDA@(.03)=NOW

 ..S @FDA@(.04)=DUZ

 .E  I VCODE="PT" D  ; Use same SUBIEN as previous "P" record

 ..Q:+SUBIEN&(SUBIEN["@")

 ..S PTCOMM=$P(VFSTR,U,3)

 ..I PTCOMM="" 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))=PTCOMM

 ...;S @FDA@(1,@FDA@(1,0))=$P(VFSTR,U,3)

 .E  I VCODE="S" D

 ..S SUBIEN=$P(VFSTR,U,2)

 ..I +SUBIEN&(SUBIEN["@") D DEL^BGOVAMI1(.RET2,VFIEN,SUBIEN,15) Q

 ..I SUBIEN="" S NUMNEW=$G(NUMNEW)+1,SUBIEN="+"_NUMNEW

 ..S SUBIEN=SUBIEN_","_VFIEN_","

 ..S FDA=$NA(FDA(FNUM_15,SUBIEN))

 ..S @FDA@(.01)=$P(VFSTR,U,3) ;Symptoms

 ..;S @FDA@(.019)=$P(VFSTR,U,4) ;Symptom Preferred Text

 S RET=$$UPDATE^BGOUTL(.FDA,"")

 I RET,VFNEW,$$DELETE^BGOUTL(FNUM,VFIEN)

 D:'RET VFEVT^BGOUTL2(FNUM,VFIEN,'VFNEW)

 S:'RET RET=VFIEN

 ;add #9000022 PATIENT REFUSALS FOR SERVICE/NMI file entry:

 I $G(REFUSED)]"" N RET S RET=$$SETREF^BGOVAMI1(DFN,REFUSED,REFDT,VFNEW)

 Q

 ;

NARR(DESCT,NARR) ;Provider narrative is now provider text | descriptive SNOMED CT

 S NARRPTR=0

 S NARR=NARR_"|"_DESCT

 I $L(NARR) D  Q:RET

 .S RET=$$FNDNARR^BGOUTL2(NARR)

 .S:RET>0 NARRPTR=RET,RET=""

 Q NARRPTR

 ;

 ; Return V File #

 ; This method signature allows this to be called as a Remote Procedure.

FNUM(RET,INP) S RET=9000010.62

 Q RET

BGOVAMI2  ; IHS/MSC/DKA - AMI Utilities 2 ;11-Jun-2018 13:08;DU

 +1       ;;1.1;BGO COMPONENTS;**13,14,24**;Mar 20, 2007;Build 1

 +2       ;01.23.14 - MSC/JS - move SET here to keep within 15k routine size limits

 +3       ;01.28.14 - DEBUG EVENT CALL FOR NEW AMI RECORD ADDED

 +4       ;O2.06.14 - Field .17 changed to store text

 +5       ;05.01.14 - MSC/DKA Allow neither Fib Init nor Fib Not Init.

 +6       ;

 +7       ; Add/edit V AMI entry

SET(RET,INP) ;EP

 +1       ; This is the exact opposite of the GET call.

 +2       ; INP is an array of strings.

 +3       ; The first string is the VFIEN^NumberOfLines^VisitIsLocked

 +4       ; Each subsequent string is prefixed with a letter indicating the type of record:

 +5       ; A   - Arrival

 +6       ; AT  - Arrival Text (Comment)

 +7       ; E   - EKG Done

 +8       ; EF  - EKG Findings (Multiple)

 +9       ; EFT - EKG Findings Text (Comment)

 +10      ; ET  - EKG Done Text (Comment)

 +11      ; F   - Fibrinolytic Therapy

 +12      ; FT  - Fibrinolytic Therapy Text (Comment)

 +13      ; O   - Onset Symptoms

 +14      ; OT  - Onset Symptoms Text (Comment)

 +15      ; P   - Protocol Standing Order

 +16      ; PT  - Protocol Standing Order Text (Comment)

 +17      ; S   - Symptom

 +18      ; PC  - PCI data

 +19       NEW DESCT,FDA,FNUM,NARR,NARRPTR,NOW,NUMNEW,SUBIEN,VCODE,VFIEN,VFNEW,VFSTR,VI,VIEN,REFUSED,VISDAT,DELF,VFCOMM

 +20       NEW ADT,EDT,FDT,ODT,PDT,ATCOMM,EFTCOMM,ETCOMM,FTCOMM,OTCOMM,PTCOMM,FIBTXT,REFDT,DFN,RET2,FI,SNO

 +21       SET RET=""

           SET FNUM=$$FNUM

 +22       SET VFIEN=+INP(0)

 +23       SET VFNEW='VFIEN

 +24       SET VIEN=$PIECE(INP(1),U,4)

 +25       SET VISDAT=$GET(^AUPNVSIT(VIEN,0))

 +26       SET DFN=$PIECE(VISDAT,U,5)

 +27       IF $GET(DFN)=""

               SET RET=$$ERR^BGOUTL(1062)

               QUIT 

 +28      ; Use the same value for Date/Time Entered fields

           SET NOW=$$NOW^XLFDT

 +29      ; Visit does not exist

           SET RET=$$CHKVISIT^BGOUTL(VIEN)

           IF RET

               QUIT 

 +30       IF VFNEW

               DO VFNEW^BGOUTL2(.RET,FNUM,VFIEN,VIEN)

               IF RET>0

                   SET VFIEN=RET

                   SET RET=""

 +31      ; Unknown file entry (Best match for Unable to Add V File Entry)

           IF 'VFIEN

               SET RET=$$ERR^BGOUTL(1070)

               QUIT 

 +32       SET FDA=$NAME(FDA(FNUM,VFIEN_","))

 +33       FOR VI=1:1:$PIECE(INP(0),U,2)

               Begin DoDot:1

 +34               SET VFSTR=INP(VI)

 +35               SET VCODE=$PIECE(VFSTR,U)

 +36               IF VCODE="A"

                       Begin DoDot:2

 +37                       SET FDA=$NAME(FDA(FNUM,VFIEN_","))

 +38                       SET ADT=$PIECE(VFSTR,U,2)

 +39                       IF ADT>0

                               IF ADT'["."

                                   SET ADT=(ADT-1)+.24

 +40      ;ArrivalDateTime

                           SET @FDA@(.01)=ADT

 +41      ;S @FDA@(.01)=$P(VFSTR,U,2) ;ArrivalDateTime

 +42      ;EncounterProvider

                           SET @FDA@(1204)=$PIECE(VFSTR,U,5)

                       End DoDot:2

 +43              IF '$TEST

                       IF VCODE="AT"

                           Begin DoDot:2

 +44                           SET FDA=$NAME(FDA(FNUM,VFIEN_","))

 +45      ; Comment (Date/Time Arrival)

                               SET ATCOMM=$PIECE(VFSTR,U,2)

 +46      ; Delete the comment, whether or not it already exists.

                               IF ATCOMM=""

                                   SET @FDA@(1)="@"

 +47                          IF '$TEST

                                   Begin DoDot:3

 +48                                   SET @FDA@(1)=$NAME(FDA(FNUM,VFIEN_",",1))

 +49                                   SET @FDA@(1,0)=$GET(@FDA@(1,0))+1

 +50                                   SET @FDA@(1,@FDA@(1,0))=ATCOMM

                                   End DoDot:3

                           End DoDot:2

 +51              IF '$TEST

                       IF VCODE="E"

                           Begin DoDot:2

 +52                           SET FDA=$NAME(FDA(FNUM,VFIEN_","))

 +53                           SET SNO=$$GET^XPAR("ALL","BGO EKG DONE SNOMED",1,"E")

 +54                           IF $PIECE(VFSTR,U,2)]""

                                   Begin DoDot:3

 +55                                   SET EDT=$PIECE(VFSTR,U,2)

 +56                                   IF EDT>0

                                           IF EDT'["."

                                               SET EDT=(EDT-1)+.24

 +57      ;EKGDone(Date/Time)

                                       SET @FDA@(.07)=EDT

 +58      ;S @FDA@(.07)=$P(VFSTR,U,2) ;EKGDoneDateTime

 +59                                   SET @FDA@(.08)=NOW

 +60                                   SET @FDA@(.09)=DUZ

 +61      ;EventDateTime

                                       SET @FDA@(1201)=$PIECE(VFSTR,U,3)

 +62      ;OrderingProvider

                                       SET @FDA@(1202)=$PIECE(VFSTR,U,4)

 +63      ;OutsideProviderName

                                       SET @FDA@(1210)=$PIECE(VFSTR,U,5)

 +64      ;OrderingLocation

                                       SET @FDA@(1215)=$PIECE(VFSTR,U,6)

 +65      ;EKG done SNOMED term Patch 24

                                       IF EDT>0

                                           SET @FDA@(1101)=SNO

                                   End DoDot:3

 +66      ;                             1.22.14

                               IF $PIECE(VFSTR,U,2)=""

                                   Begin DoDot:3

 +67      ;EKGDone(Date/Time)

                                       SET @FDA@(.07)="@"

 +68      ;EKGDateTimeEntered

                                       SET @FDA@(.08)="@"

 +69      ;EKGEnteredBy

                                       SET @FDA@(.09)="@"

 +70      ;EventDateTime

                                       SET @FDA@(1201)="@"

 +71      ;OrderingProvider

                                       SET @FDA@(1202)="@"

 +72      ;OutsideProviderName

                                       SET @FDA@(1210)="@"

 +73      ;OrderingLocation

                                       SET @FDA@(1215)="@"

 +74      ;EKG done code patch 24

                                       SET @FDA@(1101)="@"

 +75      ;EKG Comment [ET]

                                       SET @FDA@(3)="@"

                                   End DoDot:3

                           End DoDot:2

 +76              IF '$TEST

                       IF VCODE="EF"

                           Begin DoDot:2

 +77                           SET SUBIEN=$PIECE(VFSTR,U,2)

 +78                           IF +SUBIEN&(SUBIEN["@")

                                   DO DEL^BGOVAMI1(.RET2,VFIEN,SUBIEN,14)

                                   QUIT 

 +79                           IF SUBIEN=""

                                   SET NUMNEW=$GET(NUMNEW)+1

                                   SET SUBIEN="+"_NUMNEW

 +80                           SET SUBIEN=SUBIEN_","_VFIEN_","

 +81                           SET FDA=$NAME(FDA(FNUM_14,SUBIEN))

 +82      ;EkgFindingsConceptId

                               SET @FDA@(.01)=$PIECE(VFSTR,U,3)

 +83      ;Description ID

                               SET (DESCT,@FDA@(.02))=$PIECE(VFSTR,U,4)

 +84      ;Provider Text

                               SET (NARR,@FDA@(.03))=$PIECE(VFSTR,U,5)

 +85                           IF DESCT]""

                                   IF NARR]""

                                       SET NARRPTR=$$NARR(DESCT,NARR)

 +86                           SET @FDA@(.03)=$SELECT($GET(NARRPTR)>0:NARRPTR,1:"")

 +87      ;ICD-9

                               SET @FDA@(.04)=$PIECE(VFSTR,U,6)

 +88      ;Interpreted By

                               SET @FDA@(.06)=$PIECE(VFSTR,U,7)

 +89      ;Event Date/Time

                               SET @FDA@(.07)=$PIECE(VFSTR,U,8)

 +90      ; Date/Time Entered

                               SET @FDA@(.08)=NOW

 +91      ; Entered By

                               SET @FDA@(.09)=DUZ

                           End DoDot:2

 +92      ; Use same SUBIEN as previous "EF" record

                  IF '$TEST

                       IF VCODE="EFT"

                           Begin DoDot:2

 +93                           IF +SUBIEN&(SUBIEN["@")

                                   QUIT 

 +94                           SET EFTCOMM=$PIECE(VFSTR,U,3)

 +95                           IF EFTCOMM=""

                                   SET @FDA@(1)="@"

 +96                          IF '$TEST

                                   Begin DoDot:3

 +97                                   SET @FDA@(1)=$NAME(FDA(FNUM_14,SUBIEN,1))

 +98                                   SET @FDA@(1,0)=$GET(@FDA@(1,0))+1

 +99                                   SET @FDA@(1,@FDA@(1,0))=EFTCOMM

                                   End DoDot:3

                           End DoDot:2

 +100             IF '$TEST

                       IF VCODE="ET"

                           Begin DoDot:2

 +101                          SET FDA=$NAME(FDA(FNUM,VFIEN_","))

 +102     ; EKG Comment

                               SET ETCOMM=$PIECE(VFSTR,U,2)

 +103                          IF ETCOMM=""

                                   SET @FDA@(3)="@"

 +104                         IF '$TEST

                                   Begin DoDot:3

 +105                                  SET @FDA@(3)=$NAME(FDA(FNUM,VFIEN_",",3))

 +106                                  SET @FDA@(3,0)=$GET(@FDA@(3,0))+1

 +107                                  SET @FDA@(3,@FDA@(3,0))=ETCOMM

                                   End DoDot:3

                           End DoDot:2

 +108             IF '$TEST

                       IF VCODE="F"

                           Begin DoDot:2

 +109     ; 2014-05-01 DKA If no date is sent, then clear both FibInit and FibNotInit fields,

 +110     ;                else if a reason is not sent, set FibInit and clear FibNotInit fields,

 +111     ;                otherwise set FibNotInit and clear FibInit fields.

 +112                          SET FDA=$NAME(FDA(FNUM,VFIEN_","))

 +113     ;First check to see if neither FT Initiated nor FT Not Initiated (None button checked)

 +114     ; Clear all the FibInit and FibNotInit fields

                               IF $PIECE(VFSTR,U,2,3)=U

                                   FOR FI=.11:.01:.17

                                       SET @FDA@(FI)="@"

 +115     ;  $P4 = Did Not Init Fib Reason  fld#.17

                              IF '$TEST

                                   IF $PIECE(VFSTR,U,4)=""

                                       Begin DoDot:3

 +116     ; FT Initiated

 +117                                      SET FDT=$PIECE(VFSTR,U,2)

 +118                                      IF FDT>0

                                               IF FDT'["."

                                                   SET FDT=(FDT-1)+.24

 +119     ;FibrinolyticTherapyInitiated

                                           SET @FDA@(.11)=FDT

 +120     ;S @FDA@(.11)=$P(VFSTR,U,2) ;FibrinolyticTherapyInitiated

 +121                                      SET @FDA@(.12)=NOW

                                           SET @FDA@(.13)=DUZ

 +122     ; Delete any previous value for FT DidNotInit

                                           SET @FDA@(.14)="@"

 +123     ; Delete any previous value for FT DidNotInitD/TEntered

                                           SET @FDA@(.15)="@"

 +124     ; Delete any previous value for FT DidNotInitEnteredBy

                                           SET @FDA@(.16)="@"

 +125     ; Delete any previous value for FT DidnotInitReason

                                           SET @FDA@(.17)="@"

 +126     ;IHS/MSC/MGH Try to remove any refusal reason if this is an edit

 +127                                      DO DELREF^BGOVAMI1(VFIEN)

                                       End DoDot:3

 +128                         IF '$TEST

                                   Begin DoDot:3

 +129     ; FT Not Initiated

 +130     ;DidNotInit (Date)

                                       SET (@FDA@(.14),REFDT)=$PIECE(VFSTR,U,3)

 +131                                  SET @FDA@(.15)=NOW

                                       SET @FDA@(.16)=DUZ

 +132     ;S (@FDA@(.17),REFUSED)=$P(VFSTR,U,4) ;DidnotInitReason

 +133                                  SET REFUSED=$PIECE(VFSTR,U,4)

 +134                                  SET FIBTXT=$$GET1^DIQ(9999999.102,REFUSED,.01)

 +135                                  SET @FDA@(.17)=FIBTXT

 +136     ; Delete any previous value for FT Initiated

                                       SET @FDA@(.11)="@"

 +137     ; Delete any previous value for FT D/TEntered

                                       SET @FDA@(.12)="@"

 +138     ; Delete any previous value for FT EnteredBy

                                       SET @FDA@(.13)="@"

                                   End DoDot:3

                           End DoDot:2

 +139             IF '$TEST

                       IF VCODE="FT"

                           Begin DoDot:2

 +140                          SET FDA=$NAME(FDA(FNUM,VFIEN_","))

 +141     ; Fibrinolytic Therapy Comment

                               SET FTCOMM=$PIECE(VFSTR,U,2)

 +142     ; Delete the comment, whether or not it already exists.

                               IF FTCOMM=""

                                   SET @FDA@(4)="@"

 +143                         IF '$TEST

                                   Begin DoDot:3

 +144                                  SET @FDA@(4)=$NAME(FDA(FNUM,VFIEN_",",4))

 +145                                  SET @FDA@(4,0)=$GET(@FDA@(4,0))+1

 +146                                  SET @FDA@(4,@FDA@(4,0))=FTCOMM

                                   End DoDot:3

                           End DoDot:2

 +147     ;IHS/MSC/MGH Patch 24 for PCI

 +148             IF '$TEST

                       IF VCODE="PC"

                           Begin DoDot:2

 +149                          SET FDA=$NAME(FDA(FNUM,VFIEN_","))

 +150                          IF $PIECE(VFSTR,U,2)=""

                                   Begin DoDot:3

 +151                                  SET @FDA@(1102)="@"

 +152                                  SET @FDA@(1103)="@"

                                   End DoDot:3

 +153                         IF '$TEST

                                   Begin DoDot:3

 +154                                  SET @FDA@(1102)=$PIECE(VFSTR,U,2)

 +155                                  IF $PIECE(VFSTR,U,3)=""

                                           SET @FDA@(1103)="@"

 +156                                 IF '$TEST

                                           SET @FDA@(1103)=$PIECE(VFSTR,U,3)

                                   End DoDot:3

                           End DoDot:2

 +157             IF '$TEST

                       IF VCODE="O"

                           Begin DoDot:2

 +158                          SET FDA=$NAME(FDA(FNUM,VFIEN_","))

 +159                          SET ODT=$PIECE(VFSTR,U,2)

 +160                          IF ODT>0

                                   IF ODT'["."

                                       SET ODT=(ODT-1)+.24

 +161     ;OnsetSymptoms

                               SET @FDA@(.04)=ODT

 +162     ;S @FDA@(.04)=$P(VFSTR,U,2) ;OnsetSymptoms

 +163                          SET @FDA@(.05)=NOW

 +164                          SET @FDA@(.06)=DUZ

                           End DoDot:2

 +165             IF '$TEST

                       IF VCODE="OT"

                           Begin DoDot:2

 +166                          SET FDA=$NAME(FDA(FNUM,VFIEN_","))

 +167                          SET @FDA@(2)=$NAME(FDA(FNUM,VFIEN_",",2))

 +168     ; Onset Symptoms Text

                               SET OTCOMM=$PIECE(VFSTR,U,2)

 +169     ; Delete the comment, whether or not it already exists.

                               IF OTCOMM=""

                                   SET @FDA@(2)="@"

 +170                         IF '$TEST

                                   Begin DoDot:3

 +171                                  SET @FDA@(2)=$NAME(FDA(FNUM,VFIEN_",",2))

 +172                                  SET @FDA@(2,0)=$GET(@FDA@(2,0))+1

 +173                                  SET @FDA@(2,@FDA@(2,0))=OTCOMM

                                   End DoDot:3

                           End DoDot:2

 +174     ; Protocol Standing Orders (Sub-File)

                  IF '$TEST

                       IF VCODE="P"

                           Begin DoDot:2

 +175                          SET SUBIEN=$PIECE(VFSTR,U,2)

 +176                          IF +SUBIEN&(SUBIEN["@")

                                   DO DEL^BGOVAMI1(.RET2,VFIEN,SUBIEN,13)

                                   QUIT 

 +177                          IF SUBIEN=""

                                   SET NUMNEW=$GET(NUMNEW)+1

                                   SET SUBIEN="+"_NUMNEW

 +178                          SET SUBIEN=SUBIEN_","_VFIEN_","

 +179                          SET FDA=$NAME(FDA(FNUM_13,SUBIEN))

 +180                          SET @FDA@(.01)=$PIECE(VFSTR,U,3)

 +181                          SET PDT=$PIECE(VFSTR,U,4)

 +182                          IF PDT>0

                                   IF PDT'["."

                                       SET PDT=(PDT-1)+.24

 +183     ;ProtocolEventDateTime

                               SET @FDA@(.02)=PDT

 +184     ;S @FDA@(.02)=$P(VFSTR,U,4) ;ProtocolEventDateTime

 +185                          SET @FDA@(.03)=NOW

 +186                          SET @FDA@(.04)=DUZ

                           End DoDot:2

 +187     ; Use same SUBIEN as previous "P" record

                  IF '$TEST

                       IF VCODE="PT"

                           Begin DoDot:2

 +188                          IF +SUBIEN&(SUBIEN["@")

                                   QUIT 

 +189                          SET PTCOMM=$PIECE(VFSTR,U,3)

 +190                          IF PTCOMM=""

                                   SET @FDA@(1)="@"

 +191                         IF '$TEST

                                   Begin DoDot:3

 +192                                  SET @FDA@(1)=$NAME(FDA(FNUM_13,SUBIEN,1))

 +193                                  SET @FDA@(1,0)=$GET(@FDA@(1,0))+1

 +194                                  SET @FDA@(1,@FDA@(1,0))=PTCOMM

 +195     ;S @FDA@(1,@FDA@(1,0))=$P(VFSTR,U,3)

                                   End DoDot:3

                           End DoDot:2

 +196             IF '$TEST

                       IF VCODE="S"

                           Begin DoDot:2

 +197                          SET SUBIEN=$PIECE(VFSTR,U,2)

 +198                          IF +SUBIEN&(SUBIEN["@")

                                   DO DEL^BGOVAMI1(.RET2,VFIEN,SUBIEN,15)

                                   QUIT 

 +199                          IF SUBIEN=""

                                   SET NUMNEW=$GET(NUMNEW)+1

                                   SET SUBIEN="+"_NUMNEW

 +200                          SET SUBIEN=SUBIEN_","_VFIEN_","

 +201                          SET FDA=$NAME(FDA(FNUM_15,SUBIEN))

 +202     ;Symptoms

                               SET @FDA@(.01)=$PIECE(VFSTR,U,3)

 +203     ;S @FDA@(.019)=$P(VFSTR,U,4) ;Symptom Preferred Text

                           End DoDot:2

               End DoDot:1

 +204      SET RET=$$UPDATE^BGOUTL(.FDA,"")

 +205      IF RET

               IF VFNEW

                   IF $$DELETE^BGOUTL(FNUM,VFIEN)

 +206      IF 'RET

               DO VFEVT^BGOUTL2(FNUM,VFIEN,'VFNEW)

 +207      IF 'RET

               SET RET=VFIEN

 +208     ;add #9000022 PATIENT REFUSALS FOR SERVICE/NMI file entry:

 +209      IF $GET(REFUSED)]""

               NEW RET

               SET RET=$$SETREF^BGOVAMI1(DFN,REFUSED,REFDT,VFNEW)

 +210      QUIT 

 +211     ;

NARR(DESCT,NARR) ;Provider narrative is now provider text | descriptive SNOMED CT

 +1        SET NARRPTR=0

 +2        SET NARR=NARR_"|"_DESCT

 +3        IF $LENGTH(NARR)

               Begin DoDot:1

 +4                SET RET=$$FNDNARR^BGOUTL2(NARR)

 +5                IF RET>0

                       SET NARRPTR=RET

                       SET RET=""

               End DoDot:1

               IF RET

                   QUIT 

 +6        QUIT NARRPTR