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
+7 ;
+8 ; Return V File #
+9 ; This method signature allows this to be called as a Remote Procedure.
FNUM(RET,INP) SET RET=9000010.62
+1 QUIT RET
