BGOVSTR1 ; MSC/JS - Utility calls for V STROKE ;14-Oct-2014 11:09;DU
;;1.1;BGO COMPONENTS;**13,14**;Mar 20, 2007;Build 16
;1.10.14 MSC/JS - Move MIDGET and MIDSET calls here, add ICD10 conversion date check for Stroke Symptoms multiple subfld .01, .02
;1.13.14 MSC/JS - Move GETVFIEN and NARR here to keep routine BGOVSTR within 15k size limits
;1.14.14 MSC/JS - Delete MIDSET,MIDGET,KEYLIST,LEYFLDS,KEYNAME,KEYNAMS code since no longer used.
;1.24.14 MSC/JS - Changed loop to sum up 'VALUE' from 1:1:19 to 1:1:20 for filing Stroke Score in V Measurement file
;2.6.14 MSC/MGH- Changed refusal to try and find existing one on edit
;
NARR(DESCT,NARR) ;Provider narrative is now provider text | descriptive SNOMED CT
N NARRPTR
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
; Fetch V File entries
; INP = Patient IEN (for entries associated with a patient) [1] ^
; V File IEN (for single entry) [2] ^
; Visit IEN (for entries associated with a visit) [3]
GETVFIEN(RET,INP) ;EP
N DFN,GBL,VFIEN,VIEN,XREF
S RET=0,GBL=$$ROOT^DILFD($$FNUM,,1)
I '$L(GBL) S RET=$$ERR^BGOUTL(1069) Q
S DFN=+INP
S VFIEN=$P(INP,U,2)
S VIEN=$P(INP,U,3)
; If the VFIEN is present, then use that
I VFIEN D
.I '$D(@GBL@(VFIEN,0)) S RET=$$ERR^BGOUTL(1070)
.E S RET=1,RET(1)=VFIEN
E I VIEN D
.S (RET,VFIEN)=0
.F S VFIEN=$O(@GBL@("AD",VIEN,VFIEN)) Q:'VFIEN S RET=RET+1,RET(RET)=VFIEN
E I DFN D
.S VFIEN="",XREF=$$VFPTXREF^BGOUTL2
.; Return the records newest to oldest
.F S VFIEN=$O(@GBL@(XREF,DFN,VFIEN),-1) Q:'VFIEN S RET=RET+1,RET(RET)=VFIEN
E S RET=$$ERR^BGOUTL(1008)
Q
;Check/Reset Stroke Symptoms multiple .01 CONCEPT ID value, .02 DESCRIPTION ID if VISIT date VDTE is before ICD10 conversion date (10.1.14)
; If Stroke record is created before 10.1.14 and edited afterwards, the Snomed CT value and ICD code lookup is ICD9.
; 1400 STROKE SYMPTOMS (Multiple-9000010.6314), [14;0]
; .01 CONCEPT ID (F), [0;1]
; .02 DESCRIPTION ID (F), [0;2]
;
; INP = Visit ien (VIEN)
; Returns: 0 (Visit date is after ICD10 implementation date)
; 1 ^ ICD9 Snomed Concept ID ^ ICD9 Snomed Description ID ^ ICD9 code
CHKICDT(RET,INP) ;
N IMP,VDTE
S RET=0
S VDTE=$P($G(^AUPNVSIT(VIEN,0)),U,1)
;Changes added for ICD-10 conversion
I $$AICD^BGOUTL2 D
.S IMP=$$IMP^ICDEX("10D",DT)
I $G(IMP)="" Q RET
I VDTE>IMP Q RET
; -- add call to BSTS to get ICD9 version of Snomed Concept ID, Snomed Description ID, and ICD9 code --
Q RET
;Add entry to file #9000022 PATIENT REFUSALS FOR SERVICE/NMI for patient refused Therapy
; INP = Refusal IEN [1] ^ Refusal Type [2] ^ Item IEN [3] ^ Patient IEN [4] ^
; Refusal Date [5] ^ Comment [6] ^ Provider IEN [7] ^ Reason [8]
SETREF(DFN,REFRES,REFDT,VFNEW) ; EP
S RET=""
I $G(DFN)="" Q RET
N TYPE,DTDONE,CPT,RIEN,FOUND
S RIEN=""
S TYPE="CPT"
S CPT=$$GET^XPAR("ALL","BGO STROKE TROMBO NOT DONE",1,"E")
S CPT=$O(^ICPT("BA",$G(CPT)_" ",0))
S:CPT="" CPT=37195 ; default to CPT code THROMBOLYTIC THERAPY, STROKE
I '+REFRES S REFRES=23
S DTDONE=$P(REFDT,".",1)
I DTDONE="" S DTDONE="TODAY",DTDONE=$$DT^CIAU(DTDONE)
I 'VFNEW D
.S FOUND=0
.N INV,Y
.S INV="" F S INV=$O(^AUPNPREF("AA",DFN,81,CPT,INV)) Q:INV=""!(FOUND=1) D
..S Y=9999999-INV
..Q:Y'=DTDONE
..S REFIEN=$O(^AUPNPREF("AA",DFN,81,CPT,INV,""))
..I +REFIEN S RIEN=REFIEN,FOUND=1
S INP=RIEN_U_TYPE_U_CPT_U_DFN_U_DTDONE_U_U_DUZ_U_REFRES ; 23 = Refused
D SET^BGOREF(.RET,INP)
I RET="" S RET=1
Q RET
;Delete entry from PATIENT REFUSALS FOR SERVICE/NMI file #9000022 for V Stroke record logical delete
; INP = V Stroke file ien VFIEN
DELREF(VFIEN) ; EP
S RET=""
I $G(VFIEN)="" Q RET
;I $G(^AUPNVSTR(VFIEN,5))="" Q RET ; not a deleted record
N DECDT,DFN,DNIRDT,DNIRDUZ,FNUM,INVDATE,NOD0,FILIEN,REFIEN,TYPE,CPT
S NOD0=$G(^AUPNVSTR(VFIEN,0))
S DFN=$P(NOD0,"^",2),DNIRDT=$P($P(NOD0,"^",15),".",1),DNIRDUZ=$P(NOD0,"^",16)
I DNIRDT="" S DNIRDT=$P($P(NOD0,"^",12),".",1) ;Get entered date if it was an edit
;I $G(DFN)=""!($G(DNIRDT)="")!($G(DNIRDUZ)="") Q RET
I $G(DFN)=""!($G(DNIRDT)="") Q RET
S INVDATE=9999999-DNIRDT
S CPT=$$GET^XPAR("ALL","BGO STROKE THROMBO NOT DONE",1,"E")
S TYPE=+$$CPT^ICPTCOD(CPT)
I TYPE<0 Q RET
N FNUM S FNUM=81 ; p13 CPT codes only
S DECDT=0
F S DECDT=$O(^AUPNPREF("AA",DFN,FNUM,TYPE,DECDT)) Q:'DECDT D
.Q:DECDT'=INVDATE
.S FILIEN="",FILIEN=$O(^AUPNPREF("AA",DFN,FNUM,TYPE,DECDT,FILIEN))
.N ENTBY,NOD12
.S NOD12=$G(^AUPNPREF(FILIEN,12)),ENTBY=$P(NOD12,U,17)
.Q:ENTBY=""
.I ENTBY=DNIRDUZ!(DNIRDUZ="") S REFIEN=FILIEN
I $G(REFIEN)="" Q RET
N DELRET
D DEL^BGOREF(.DELRET,REFIEN)
I DELRET="" S RET=1
Q RET
;Display V STROKE entry fld#.17 DID NOT INIT FIB REASON Snomed code + XPAR CPT code
; DNIR = fld #.17 Snomed code [1]
; checks DNIR value with API call to verify CONCEPT ID code is valid, if not defaults to:
; REFUSAL REASONS file #9999999.102 IEN 17 CONCEPT ID: 275936005
; USE WITH MEDICATION REFUSAL: YES .07 CODE VALUE: DECLINED SERVICE
; SCREEN: ALL
; CONCEPT ID PREFERRED TERM (c): Patient noncompliance - general (situation)
GETREF(DNIR) ; EP
N SNOINFO
S SNOINFO=""
I +$G(DNIR)="" Q SNOINFO
NEW CPT,CPTDESC,IN,SNOCHEK,SNODESC
;check for valid Snomed ID, input IN (Snomed ID)
;Output -
; Function returns - [1]^[2]^[3]^[4]
; [1] - Description Id of Fully Specified Name
; [2] - Fully Specified Name
; [3] - Description Id of Preferred Term
; [4] - Preferred Term
S IN=$G(DNIR)_"^^^1" D
.K ^TMP("BSTSCMCL",$J)
.S SNOCHEK=$$CONC^BSTSAPI(IN)
.K ^TMP("BSTSCMCL",$J)
.S SNODESC=$P(SNOCHEK,"^",2)
.I SNODESC="" D ; stored V Stroke field invalid, use default ID
..S IN=275936005_"^^^1"
..K ^TMP("BSTSCMCL",$J)
..S SNOCHEK=$$CONC^BSTSAPI(IN)
..K ^TMP("BSTSCMCL",$J)
..S SNODESC=$P(SNOCHEK,"^",2)
S CPT=$$GET^XPAR("SYS","BGO STROKE TROMBO NOT DONE")
S:CPT="" CPT=37195
S CPTDESC=$$GET1^DIQ(81,CPT,2,"E")
S SNOINFO=$G(SNODESC)_" - "_$G(CPTDESC)
Q SNOINFO
;Add new LKW entry if onset of symptoms is entered
SETLKW(INP) ; EP
N EVDATE,VIEN,FNUM,LKWDATE,NUM,MIEN,TYPE,VALUE,VI,VFSTR,VMIEN,VMINP,WITNESS,FOUND
N INVDT,MEAIEN,MEAVIEN,IEN
S FOUND=0
S DFN=$P(INP,U,1)
S VIEN=$P(INP,U,2)
S VMIEN=$P(INP,U,4)
I $G(VIEN)="" S RET="-1^Missing Visit IEN" Q RET
I '$D(^AUPNVSIT(VIEN)) S RET=$$ERR^BGOUTL(1035) Q RET ; Item not found
S RET="" S FNUM=9000010.01
S TYPE="LKW"
S VALUE="WELL"
S EVDATE=$P(INP,U,3)
I VMIEN'="" D
.I '$D(^AUPNVMSR(VMIEN)) S VMIEN=""
.I $$GET1^DIQ(9000010.01,VMIEN,2,"I")=1 S VMIEN=""
;S MIEN=$O(^AUTTMSR("B","LKW",""))
;Q:MIEN=""
;S INVDT="" F S INVDT=$O(^AUPNVMSR("AA",DFN,MIEN,INVDT)) Q:INVDT=""!(FOUND=1) D
;.S MEAIEN="" F S MEAIEN=$O(^AUPNVMSR("AA",DFN,MIEN,INVDT,MEAIEN)) Q:MEAIEN=""!(FOUND=1) D
;..S MEAVIEN=$P($G(^AUPNVMSR(MEAIEN,0)),U,3)
;..I MEAVIEN=VIEN S VMIEN=MEAIEN,FOUND=1
; VMINP= Visit IEN [1] ^ V File IEN [2] ^ Type [3] ^ Value [4] ^ Date/Time [5]
S VMINP=$G(VIEN)_U_$G(VMIEN)_U_$G(TYPE)_U_$G(VALUE)_U_$G(EVDATE)
D SET^BGOVMSR(.RET,.VMINP)
S VMIEN=RET
Q RET
;Add/edit V Measurement NIH entry:
; 1. Add entry if VFNEW and 'N' string exists (new V STROKE entry can be added w/o NIH data)
; 2. Add entry if 'VFNEW and 'N' string exists (existing V STROKE entry update, 'N' sent only if update)
SETNIH(VFIEN,VIEN,INP) ; EP
I $G(VIEN)="" S RET="-1^Missing Visit IEN" Q RET
I '$D(^AUPNVSIT(VIEN)) S RET=$$ERR^BGOUTL(1035) Q RET ; Item not found
N EVDATE,FNUM,I,VALUE,NUM,QIEN,QUAL,QUALS,SUM,TYPE,VMIEN,VCODE,VI,VFSTR,VMIEN,VMINP,SIEN,DEL,OLDVAL
S RET="" S FNUM=9000010.01
S NUM="" F S NUM=$O(INP(NUM)) Q:NUM="" D
.S VFSTR=$G(INP(NUM)) Q:VFSTR=""
.S VCODE=$P(VFSTR,U)
.I VCODE="N" D
..;S VALUE=0 F SUM=5:1:19 S VALUE=VALUE+$P($G(VFSTR),U,SUM) ;.19 TotalStrokeScale;
..S VALUE=0 F SUM=6:1:20 S VALUE=VALUE+$P($G(VFSTR),U,SUM) ;.19 TotalStrokeScale; 1.24.14
..S IEN=$P(VFSTR,U,2)
..S DEL=$P(VFSTR,U,5)
..Q:DEL="@"
..S QUALS=$P(VFSTR,U,22,99)
..S TYPE="NSST"
..I IEN="" D
...S VMIEN=$$STRNIH($G(VIEN),$G(TYPE),$G(VALUE)) ;New Item to add
...S IEN=9999999
...S IEN=$O(^AUPNVSTR(VFIEN,15,IEN),-1)
..E D
...S VMIEN=$$GET1^DIQ(9000010.6315,IEN_","_VFIEN_",",.2,"I") ;Get current value
...I VMIEN="" S VMIEN=$$STRNIH($G(VIEN),$G(TYPE),$G(VALUE)) ;Add if nothing there
...E D
....S OLDVAL=$$GET1^DIQ(9000010.01,VMIEN,.04)
....I '$D(^AUPNVMSR(VMIEN)) S VMIEN=$$STRNIH($G(VIEN),$G(TYPE),$G(VALUE)) Q ;add if non-existent measurement
....I $$GET1^DIQ(9000010.01,VMIEN,2,"I")=1 S VMIEN=$$STRNIH($G(VIEN),$G(TYPE),$G(VALUE)) ;Add if measurement is EIE
....I OLDVAL'=VALUE D STRDEL(VMIEN) S VMIEN=$$STRNIH($G(VIEN),$G(TYPE),$G(VALUE)) ;Delete old and add new if changed
..D HOOK(IEN,$G(VMIEN)) S RET=VMIEN
Q RET
STRDEL(VMIEN) ;Do the delete
N INP
S INP=VMIEN_"^4"
D SETEIE
Q
STRNIH(VIEN,TYPE,VALUE) ;Store the NSST
N NIHEV S NIHEV=$P(VFSTR,U,3) ;.02 NIH EventDateTime
I NIHEV N Y S Y=NIHEV X ^DD("DD") S NIHEV=Y
N EVDATE S EVDATE=$E($P(VFSTR,U,4),1,12) ;Don't include seconds
I EVDATE N Y S Y=EVDATE X ^DD("DD") S EVDATE=Y
; VMINP= Visit IEN [1] ^ V File IEN [2] ^ Type [3] ^ Value [4] ^ Date/Time [5]
S VMIEN=""
S VMINP=$G(VIEN)_U_$G(VMIEN)_U_$G(TYPE)_U_$G(VALUE)_U_$G(EVDATE)
D SET^BGOVMSR(.RET,.VMINP)
I RET'>0 S RET="-1^V Measurement NIH entry was not added" Q RET
S VMIEN=RET
S FDA=$NA(FDA(FNUM,VMIEN_","))
S @FDA@(.07)=$S($G(NIHEV)]"":NIHEV,1:EVDATE) ; [.07] DATE/TIME VITALS ENTERED (D)
S @FDA@(.08)="`"_DUZ ; [.08] ENTERED BY (P200')
S @FDA@(1216)=$S($G(EVDATE)]"":EVDATE,1:"N") ; [1216] DATE/TIME ENTERED (D)
S @FDA@(1217)="`"_DUZ ; [1217] ENTERED BY (P200')
S @FDA@(1218)=$S($G(EVDATE)]"":EVDATE,1:"N") ; [1218] DATE/TIME LAST MODIFIED (D)
S RET=$$UPDATE^BGOUTL(.FDA,"E")
I RET,VFNEW,$$DELETE^BGOUTL(FNUM,VMIEN) Q RET
D:'RET VFEVT^BGOUTL2(FNUM,VMIEN,'$G(VFNEW))
S:'RET RET=VMIEN
;Add in the Qualifier multiple, QUALS array = N array $P22, $P23, $P24, etc.
F I=1:1 S QUAL=$P(QUALS,U,I) Q:QUAL="" D
.S QIEN="+"_I_","_VMIEN_","
.N FDA,ERR,IEN2
.S FDA(FNUM_5,QIEN,.01)=QUAL ; [5] QUALIFIER (Multiple-9000010.015)
.D UPDATE^DIE(,"FDA","IEN2","ERR")
.I $G(ERR("DIERR",1)) S RET=-ERR("DIERR",1)_U_ERR("DIERR",1,"TEXT",1)
Q RET
HOOK(IEN,VMIEN) ;Hook it back to the parent
I +VMIEN D
.N SIEN,FDA,ERR,IEN2
.I DEL="@" S VMIEN="@"
.S SIEN=IEN_","_VFIEN_","
.S FDA(9000010.6315,SIEN,.2)=VMIEN
.D UPDATE^DIE(,"FDA","IEN2","ERR")
Q
; EIE V Measurement file entries for LKW or NSST
; VFIEN = V STROKE file ien VFIEN
; Flag the entry as Entered in Error
EIEVM(RET2,VFIEN) ;EP
N VIEN,VMARR
K VMARR
S VIEN=$P($G(^AUPNVSTR(VFIEN,0)),"^",3)
I $G(VIEN)="" S RET=0 Q
D GETVM(VIEN)
I RET=0 Q RET ; no VM entries for Visit IEN found
N VMFIEN
S VMFIEN=""
F S VMFIEN=$O(VMARR(VMFIEN)) Q:VMFIEN="" D
.N INP
.S INP=VMFIEN_"^4" ; Reason = 4 = INVALID RECORD (default)
.D SETEIE
Q
; Return V Measurement file entries for visit VIEN
; Input = VIEN
; Returns: 1/entries in VMARR array, 0/No entries found
; Screen for TYPE = LKW or NSST entries
; For NSST entries field match criteria:
; [NIHDAT] .02 EVENT DATE/TIME (D), [0;2] = [VITALDT] .07 DATE/TIME VITALS ENTERED (D), [0;7]
; [NIHVALUE] .19 TOTAL STROKE SCORE (NJ2,0),[0;19] = [VALUE] .04 VALUE (RFXO), [0;4]
GETVM(VIEN) ;
N CNT,VMIEN,VALUE,VITALDT
I 'VIEN S VMARR(1)=$$ERR^BGOUTL(1002) Q
S (CNT,VMIEN,RET)=0
F S VMIEN=$O(^AUPNVMSR("AD",VIEN,VMIEN)) Q:'VMIEN D
.N X,USR,DAT,TYPE,TYPENM
.S X=$G(^AUPNVMSR(VMIEN,0))
.Q:X=""
.S VALUE=$P(X,"^",4),VITALDT=$P($G(^AUPNVMSR(VMIEN,12)),"^",1)
.S DAT=+$G(^(12)),USR=+$P($G(^(12)),U,4)
.S TYPE=+X
.S TYPENM=$P($G(^AUTTMSR(TYPE,0)),U)
.Q:TYPENM=""
.Q:TYPENM'="LKW"&(TYPENM'="NSST") ; only LKW and NSST records
.N NAME
.S NAME=$P($G(^VA(200,USR,0)),U)
.S:'DAT DAT=+$G(^AUPNVSIT(VIEN,0))
.I TYPENM="NSST" D
..N NIHDT,NIHREC
..S NIHDT=0
..F S NIHDT=$O(^AUPNVSTR(VFIEN,15,"B",NIHDT)) Q:'NIHDT D
...S NIHREC=0,NIHREC=$O(^AUPNVSTR(VFIEN,15,"B",NIHDT,NIHREC))
...N NIHNODE,NIHVALUE,NIHDAT
...S NIHNODE=$G(^AUPNVSTR(VFIEN,15,NIHREC,0)),NIHDAT=$E($P(NIHNODE,"^",2),1,12),NIHVALUE=$P(NIHNODE,"^",19)
...Q:NIHDAT'=VITALDT!(NIHVALUE'=VALUE)
...S VMARR(VMIEN)=TYPENM_U_DAT_U_$$ISLOCKED^BEHOENCX(VIEN) ; NSST ENTRY
.S:TYPENM="LKW" VMARR(VMIEN)=TYPENM_U_DAT_U_$$ISLOCKED^BEHOENCX(VIEN) ; LKW ENTRY
.S CNT=CNT+1
I $D(VMARR) S RET=1
Q RET
; Update EIE for V Measurement file entry
SETEIE ;
N FDA,REASON,VFIEN
S VFIEN=$P(INP,U)
S REASON=$P(INP,U,2)
I REASON<0 I REASON>4 S RET="-1^Reason EIE out of range" Q ; Input out of range
I VFIEN="" S RET=$$ERR^BGOUTL(1008) Q ; Missing input data
I '$D(^AUPNVMSR(VFIEN)) S RET=$$ERR^BGOUTL(1035) Q ; Item not found
S FDA=$NA(FDA(9000010.01,VFIEN_","))
S @FDA@(2)=1
S @FDA@(3)=DUZ
S RET=$$UPDATE^BGOUTL(.FDA,,VFIEN)
N EIEN S EIEN="+1,"_VFIEN_","
N FDA,ERR,IEN2
;S FDA($$FNUM_4,EIEN,.01)=REASON
S FDA(9000010.014,EIEN,.01)=REASON
D UPDATE^DIE(,"FDA","IEN2","ERR")
I $G(ERR("DIERR",1)) S RET=-ERR("DIERR",1)_U_ERR("DIERR",1,"TEXT",1)
S:RET="" RET=1
Q
;Return V File #
FNUM(RET,INP) S RET=9000010.63
Q RET
;
DMULT(RET,VFIEN,SUBIEN,NODE) ; Delete a multiple entry from V file
I $G(VFIEN)=""!($G(SUBIEN)="")!($G(NODE)="") S RET="-1^""missing delete multiple parameter""" Q RET
N ERR,DA,DIK
S ERR=""
S RET=""
S DA(1)=VFIEN,DA=+SUBIEN
S DIK="^AUPNVSTR("_DA(1)_NODE
S:DA ERR=$$DELETE^BGOUTL(DIK,.DA)
I ERR'="" S RET=RET_"^"_ERR
Q
BGOVSTR1 ; MSC/JS - Utility calls for V STROKE ;14-Oct-2014 11:09;DU
+1 ;;1.1;BGO COMPONENTS;**13,14**;Mar 20, 2007;Build 16
+2 ;1.10.14 MSC/JS - Move MIDGET and MIDSET calls here, add ICD10 conversion date check for Stroke Symptoms multiple subfld .01, .02
+3 ;1.13.14 MSC/JS - Move GETVFIEN and NARR here to keep routine BGOVSTR within 15k size limits
+4 ;1.14.14 MSC/JS - Delete MIDSET,MIDGET,KEYLIST,LEYFLDS,KEYNAME,KEYNAMS code since no longer used.
+5 ;1.24.14 MSC/JS - Changed loop to sum up 'VALUE' from 1:1:19 to 1:1:20 for filing Stroke Score in V Measurement file
+6 ;2.6.14 MSC/MGH- Changed refusal to try and find existing one on edit
+7 ;
NARR(DESCT,NARR) ;Provider narrative is now provider text | descriptive SNOMED CT
+1 NEW NARRPTR
+2 SET NARRPTR=0
+3 SET NARR=NARR_"|"_DESCT
+4 IF $LENGTH(NARR)
Begin DoDot:1
+5 SET RET=$$FNDNARR^BGOUTL2(NARR)
+6 IF RET>0
SET NARRPTR=RET
SET RET=""
End DoDot:1
IF RET
QUIT
+7 QUIT NARRPTR
+8 ; Fetch V File entries
+9 ; INP = Patient IEN (for entries associated with a patient) [1] ^
+10 ; V File IEN (for single entry) [2] ^
+11 ; Visit IEN (for entries associated with a visit) [3]
GETVFIEN(RET,INP) ;EP
+1 NEW DFN,GBL,VFIEN,VIEN,XREF
+2 SET RET=0
SET GBL=$$ROOT^DILFD($$FNUM,,1)
+3 IF '$LENGTH(GBL)
SET RET=$$ERR^BGOUTL(1069)
QUIT
+4 SET DFN=+INP
+5 SET VFIEN=$PIECE(INP,U,2)
+6 SET VIEN=$PIECE(INP,U,3)
+7 ; If the VFIEN is present, then use that
+8 IF VFIEN
Begin DoDot:1
+9 IF '$DATA(@GBL@(VFIEN,0))
SET RET=$$ERR^BGOUTL(1070)
+10 IF '$TEST
SET RET=1
SET RET(1)=VFIEN
End DoDot:1
+11 IF '$TEST
IF VIEN
Begin DoDot:1
+12 SET (RET,VFIEN)=0
+13 FOR
SET VFIEN=$ORDER(@GBL@("AD",VIEN,VFIEN))
IF 'VFIEN
QUIT
SET RET=RET+1
SET RET(RET)=VFIEN
End DoDot:1
+14 IF '$TEST
IF DFN
Begin DoDot:1
+15 SET VFIEN=""
SET XREF=$$VFPTXREF^BGOUTL2
+16 ; Return the records newest to oldest
+17 FOR
SET VFIEN=$ORDER(@GBL@(XREF,DFN,VFIEN),-1)
IF 'VFIEN
QUIT
SET RET=RET+1
SET RET(RET)=VFIEN
End DoDot:1
+18 IF '$TEST
SET RET=$$ERR^BGOUTL(1008)
+19 QUIT
+20 ;Check/Reset Stroke Symptoms multiple .01 CONCEPT ID value, .02 DESCRIPTION ID if VISIT date VDTE is before ICD10 conversion date (10.1.14)
+21 ; If Stroke record is created before 10.1.14 and edited afterwards, the Snomed CT value and ICD code lookup is ICD9.
+22 ; 1400 STROKE SYMPTOMS (Multiple-9000010.6314), [14;0]
+23 ; .01 CONCEPT ID (F), [0;1]
+24 ; .02 DESCRIPTION ID (F), [0;2]
+25 ;
+26 ; INP = Visit ien (VIEN)
+27 ; Returns: 0 (Visit date is after ICD10 implementation date)
+28 ; 1 ^ ICD9 Snomed Concept ID ^ ICD9 Snomed Description ID ^ ICD9 code
CHKICDT(RET,INP) ;
+1 NEW IMP,VDTE
+2 SET RET=0
+3 SET VDTE=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,1)
+4 ;Changes added for ICD-10 conversion
+5 IF $$AICD^BGOUTL2
Begin DoDot:1
+6 SET IMP=$$IMP^ICDEX("10D",DT)
End DoDot:1
+7 IF $GET(IMP)=""
QUIT RET
+8 IF VDTE>IMP
QUIT RET
+9 ; -- add call to BSTS to get ICD9 version of Snomed Concept ID, Snomed Description ID, and ICD9 code --
+10 QUIT RET
+11 ;Add entry to file #9000022 PATIENT REFUSALS FOR SERVICE/NMI for patient refused Therapy
+12 ; INP = Refusal IEN [1] ^ Refusal Type [2] ^ Item IEN [3] ^ Patient IEN [4] ^
+13 ; Refusal Date [5] ^ Comment [6] ^ Provider IEN [7] ^ Reason [8]
SETREF(DFN,REFRES,REFDT,VFNEW) ; EP
+1 SET RET=""
+2 IF $GET(DFN)=""
QUIT RET
+3 NEW TYPE,DTDONE,CPT,RIEN,FOUND
+4 SET RIEN=""
+5 SET TYPE="CPT"
+6 SET CPT=$$GET^XPAR("ALL","BGO STROKE TROMBO NOT DONE",1,"E")
+7 SET CPT=$ORDER(^ICPT("BA",$GET(CPT)_" ",0))
+8 ; default to CPT code THROMBOLYTIC THERAPY, STROKE
IF CPT=""
SET CPT=37195
+9 IF '+REFRES
SET REFRES=23
+10 SET DTDONE=$PIECE(REFDT,".",1)
+11 IF DTDONE=""
SET DTDONE="TODAY"
SET DTDONE=$$DT^CIAU(DTDONE)
+12 IF 'VFNEW
Begin DoDot:1
+13 SET FOUND=0
+14 NEW INV,Y
+15 SET INV=""
FOR
SET INV=$ORDER(^AUPNPREF("AA",DFN,81,CPT,INV))
IF INV=""!(FOUND=1)
QUIT
Begin DoDot:2
+16 SET Y=9999999-INV
+17 IF Y'=DTDONE
QUIT
+18 SET REFIEN=$ORDER(^AUPNPREF("AA",DFN,81,CPT,INV,""))
+19 IF +REFIEN
SET RIEN=REFIEN
SET FOUND=1
End DoDot:2
End DoDot:1
+20 ; 23 = Refused
SET INP=RIEN_U_TYPE_U_CPT_U_DFN_U_DTDONE_U_U_DUZ_U_REFRES
+21 DO SET^BGOREF(.RET,INP)
+22 IF RET=""
SET RET=1
+23 QUIT RET
+24 ;Delete entry from PATIENT REFUSALS FOR SERVICE/NMI file #9000022 for V Stroke record logical delete
+25 ; INP = V Stroke file ien VFIEN
DELREF(VFIEN) ; EP
+1 SET RET=""
+2 IF $GET(VFIEN)=""
QUIT RET
+3 ;I $G(^AUPNVSTR(VFIEN,5))="" Q RET ; not a deleted record
+4 NEW DECDT,DFN,DNIRDT,DNIRDUZ,FNUM,INVDATE,NOD0,FILIEN,REFIEN,TYPE,CPT
+5 SET NOD0=$GET(^AUPNVSTR(VFIEN,0))
+6 SET DFN=$PIECE(NOD0,"^",2)
SET DNIRDT=$PIECE($PIECE(NOD0,"^",15),".",1)
SET DNIRDUZ=$PIECE(NOD0,"^",16)
+7 ;Get entered date if it was an edit
IF DNIRDT=""
SET DNIRDT=$PIECE($PIECE(NOD0,"^",12),".",1)
+8 ;I $G(DFN)=""!($G(DNIRDT)="")!($G(DNIRDUZ)="") Q RET
+9 IF $GET(DFN)=""!($GET(DNIRDT)="")
QUIT RET
+10 SET INVDATE=9999999-DNIRDT
+11 SET CPT=$$GET^XPAR("ALL","BGO STROKE THROMBO NOT DONE",1,"E")
+12 SET TYPE=+$$CPT^ICPTCOD(CPT)
+13 IF TYPE<0
QUIT RET
+14 ; p13 CPT codes only
NEW FNUM
SET FNUM=81
+15 SET DECDT=0
+16 FOR
SET DECDT=$ORDER(^AUPNPREF("AA",DFN,FNUM,TYPE,DECDT))
IF 'DECDT
QUIT
Begin DoDot:1
+17 IF DECDT'=INVDATE
QUIT
+18 SET FILIEN=""
SET FILIEN=$ORDER(^AUPNPREF("AA",DFN,FNUM,TYPE,DECDT,FILIEN))
+19 NEW ENTBY,NOD12
+20 SET NOD12=$GET(^AUPNPREF(FILIEN,12))
SET ENTBY=$PIECE(NOD12,U,17)
+21 IF ENTBY=""
QUIT
+22 IF ENTBY=DNIRDUZ!(DNIRDUZ="")
SET REFIEN=FILIEN
End DoDot:1
+23 IF $GET(REFIEN)=""
QUIT RET
+24 NEW DELRET
+25 DO DEL^BGOREF(.DELRET,REFIEN)
+26 IF DELRET=""
SET RET=1
+27 QUIT RET
+28 ;Display V STROKE entry fld#.17 DID NOT INIT FIB REASON Snomed code + XPAR CPT code
+29 ; DNIR = fld #.17 Snomed code [1]
+30 ; checks DNIR value with API call to verify CONCEPT ID code is valid, if not defaults to:
+31 ; REFUSAL REASONS file #9999999.102 IEN 17 CONCEPT ID: 275936005
+32 ; USE WITH MEDICATION REFUSAL: YES .07 CODE VALUE: DECLINED SERVICE
+33 ; SCREEN: ALL
+34 ; CONCEPT ID PREFERRED TERM (c): Patient noncompliance - general (situation)
GETREF(DNIR) ; EP
+1 NEW SNOINFO
+2 SET SNOINFO=""
+3 IF +$GET(DNIR)=""
QUIT SNOINFO
+4 NEW CPT,CPTDESC,IN,SNOCHEK,SNODESC
+5 ;check for valid Snomed ID, input IN (Snomed ID)
+6 ;Output -
+7 ; Function returns - [1]^[2]^[3]^[4]
+8 ; [1] - Description Id of Fully Specified Name
+9 ; [2] - Fully Specified Name
+10 ; [3] - Description Id of Preferred Term
+11 ; [4] - Preferred Term
+12 SET IN=$GET(DNIR)_"^^^1"
Begin DoDot:1
+13 KILL ^TMP("BSTSCMCL",$JOB)
+14 SET SNOCHEK=$$CONC^BSTSAPI(IN)
+15 KILL ^TMP("BSTSCMCL",$JOB)
+16 SET SNODESC=$PIECE(SNOCHEK,"^",2)
+17 ; stored V Stroke field invalid, use default ID
IF SNODESC=""
Begin DoDot:2
+18 SET IN=275936005_"^^^1"
+19 KILL ^TMP("BSTSCMCL",$JOB)
+20 SET SNOCHEK=$$CONC^BSTSAPI(IN)
+21 KILL ^TMP("BSTSCMCL",$JOB)
+22 SET SNODESC=$PIECE(SNOCHEK,"^",2)
End DoDot:2
End DoDot:1
+23 SET CPT=$$GET^XPAR("SYS","BGO STROKE TROMBO NOT DONE")
+24 IF CPT=""
SET CPT=37195
+25 SET CPTDESC=$$GET1^DIQ(81,CPT,2,"E")
+26 SET SNOINFO=$GET(SNODESC)_" - "_$GET(CPTDESC)
+27 QUIT SNOINFO
+28 ;Add new LKW entry if onset of symptoms is entered
SETLKW(INP) ; EP
+1 NEW EVDATE,VIEN,FNUM,LKWDATE,NUM,MIEN,TYPE,VALUE,VI,VFSTR,VMIEN,VMINP,WITNESS,FOUND
+2 NEW INVDT,MEAIEN,MEAVIEN,IEN
+3 SET FOUND=0
+4 SET DFN=$PIECE(INP,U,1)
+5 SET VIEN=$PIECE(INP,U,2)
+6 SET VMIEN=$PIECE(INP,U,4)
+7 IF $GET(VIEN)=""
SET RET="-1^Missing Visit IEN"
QUIT RET
+8 ; Item not found
IF '$DATA(^AUPNVSIT(VIEN))
SET RET=$$ERR^BGOUTL(1035)
QUIT RET
+9 SET RET=""
SET FNUM=9000010.01
+10 SET TYPE="LKW"
+11 SET VALUE="WELL"
+12 SET EVDATE=$PIECE(INP,U,3)
+13 IF VMIEN'=""
Begin DoDot:1
+14 IF '$DATA(^AUPNVMSR(VMIEN))
SET VMIEN=""
+15 IF $$GET1^DIQ(9000010.01,VMIEN,2,"I")=1
SET VMIEN=""
End DoDot:1
+16 ;S MIEN=$O(^AUTTMSR("B","LKW",""))
+17 ;Q:MIEN=""
+18 ;S INVDT="" F S INVDT=$O(^AUPNVMSR("AA",DFN,MIEN,INVDT)) Q:INVDT=""!(FOUND=1) D
+19 ;.S MEAIEN="" F S MEAIEN=$O(^AUPNVMSR("AA",DFN,MIEN,INVDT,MEAIEN)) Q:MEAIEN=""!(FOUND=1) D
+20 ;..S MEAVIEN=$P($G(^AUPNVMSR(MEAIEN,0)),U,3)
+21 ;..I MEAVIEN=VIEN S VMIEN=MEAIEN,FOUND=1
+22 ; VMINP= Visit IEN [1] ^ V File IEN [2] ^ Type [3] ^ Value [4] ^ Date/Time [5]
+23 SET VMINP=$GET(VIEN)_U_$GET(VMIEN)_U_$GET(TYPE)_U_$GET(VALUE)_U_$GET(EVDATE)
+24 DO SET^BGOVMSR(.RET,.VMINP)
+25 SET VMIEN=RET
+26 QUIT RET
+27 ;Add/edit V Measurement NIH entry:
+28 ; 1. Add entry if VFNEW and 'N' string exists (new V STROKE entry can be added w/o NIH data)
+29 ; 2. Add entry if 'VFNEW and 'N' string exists (existing V STROKE entry update, 'N' sent only if update)
SETNIH(VFIEN,VIEN,INP) ; EP
+1 IF $GET(VIEN)=""
SET RET="-1^Missing Visit IEN"
QUIT RET
+2 ; Item not found
IF '$DATA(^AUPNVSIT(VIEN))
SET RET=$$ERR^BGOUTL(1035)
QUIT RET
+3 NEW EVDATE,FNUM,I,VALUE,NUM,QIEN,QUAL,QUALS,SUM,TYPE,VMIEN,VCODE,VI,VFSTR,VMIEN,VMINP,SIEN,DEL,OLDVAL
+4 SET RET=""
SET FNUM=9000010.01
+5 SET NUM=""
FOR
SET NUM=$ORDER(INP(NUM))
IF NUM=""
QUIT
Begin DoDot:1
+6 SET VFSTR=$GET(INP(NUM))
IF VFSTR=""
QUIT
+7 SET VCODE=$PIECE(VFSTR,U)
+8 IF VCODE="N"
Begin DoDot:2
+9 ;S VALUE=0 F SUM=5:1:19 S VALUE=VALUE+$P($G(VFSTR),U,SUM) ;.19 TotalStrokeScale;
+10 ;.19 TotalStrokeScale; 1.24.14
SET VALUE=0
FOR SUM=6:1:20
SET VALUE=VALUE+$PIECE($GET(VFSTR),U,SUM)
+11 SET IEN=$PIECE(VFSTR,U,2)
+12 SET DEL=$PIECE(VFSTR,U,5)
+13 IF DEL="@"
QUIT
+14 SET QUALS=$PIECE(VFSTR,U,22,99)
+15 SET TYPE="NSST"
+16 IF IEN=""
Begin DoDot:3
+17 ;New Item to add
SET VMIEN=$$STRNIH($GET(VIEN),$GET(TYPE),$GET(VALUE))
+18 SET IEN=9999999
+19 SET IEN=$ORDER(^AUPNVSTR(VFIEN,15,IEN),-1)
End DoDot:3
+20 IF '$TEST
Begin DoDot:3
+21 ;Get current value
SET VMIEN=$$GET1^DIQ(9000010.6315,IEN_","_VFIEN_",",.2,"I")
+22 ;Add if nothing there
IF VMIEN=""
SET VMIEN=$$STRNIH($GET(VIEN),$GET(TYPE),$GET(VALUE))
+23 IF '$TEST
Begin DoDot:4
+24 SET OLDVAL=$$GET1^DIQ(9000010.01,VMIEN,.04)
+25 ;add if non-existent measurement
IF '$DATA(^AUPNVMSR(VMIEN))
SET VMIEN=$$STRNIH($GET(VIEN),$GET(TYPE),$GET(VALUE))
QUIT
+26 ;Add if measurement is EIE
IF $$GET1^DIQ(9000010.01,VMIEN,2,"I")=1
SET VMIEN=$$STRNIH($GET(VIEN),$GET(TYPE),$GET(VALUE))
+27 ;Delete old and add new if changed
IF OLDVAL'=VALUE
DO STRDEL(VMIEN)
SET VMIEN=$$STRNIH($GET(VIEN),$GET(TYPE),$GET(VALUE))
End DoDot:4
End DoDot:3
+28 DO HOOK(IEN,$GET(VMIEN))
SET RET=VMIEN
End DoDot:2
End DoDot:1
+29 QUIT RET
STRDEL(VMIEN) ;Do the delete
+1 NEW INP
+2 SET INP=VMIEN_"^4"
+3 DO SETEIE
+4 QUIT
STRNIH(VIEN,TYPE,VALUE) ;Store the NSST
+1 ;.02 NIH EventDateTime
NEW NIHEV
SET NIHEV=$PIECE(VFSTR,U,3)
+2 IF NIHEV
NEW Y
SET Y=NIHEV
XECUTE ^DD("DD")
SET NIHEV=Y
+3 ;Don't include seconds
NEW EVDATE
SET EVDATE=$EXTRACT($PIECE(VFSTR,U,4),1,12)
+4 IF EVDATE
NEW Y
SET Y=EVDATE
XECUTE ^DD("DD")
SET EVDATE=Y
+5 ; VMINP= Visit IEN [1] ^ V File IEN [2] ^ Type [3] ^ Value [4] ^ Date/Time [5]
+6 SET VMIEN=""
+7 SET VMINP=$GET(VIEN)_U_$GET(VMIEN)_U_$GET(TYPE)_U_$GET(VALUE)_U_$GET(EVDATE)
+8 DO SET^BGOVMSR(.RET,.VMINP)
+9 IF RET'>0
SET RET="-1^V Measurement NIH entry was not added"
QUIT RET
+10 SET VMIEN=RET
+11 SET FDA=$NAME(FDA(FNUM,VMIEN_","))
+12 ; [.07] DATE/TIME VITALS ENTERED (D)
SET @FDA@(.07)=$SELECT($GET(NIHEV)]"":NIHEV,1:EVDATE)
+13 ; [.08] ENTERED BY (P200')
SET @FDA@(.08)="`"_DUZ
+14 ; [1216] DATE/TIME ENTERED (D)
SET @FDA@(1216)=$SELECT($GET(EVDATE)]"":EVDATE,1:"N")
+15 ; [1217] ENTERED BY (P200')
SET @FDA@(1217)="`"_DUZ
+16 ; [1218] DATE/TIME LAST MODIFIED (D)
SET @FDA@(1218)=$SELECT($GET(EVDATE)]"":EVDATE,1:"N")
+17 SET RET=$$UPDATE^BGOUTL(.FDA,"E")
+18 IF RET
IF VFNEW
IF $$DELETE^BGOUTL(FNUM,VMIEN)
QUIT RET
+19 IF 'RET
DO VFEVT^BGOUTL2(FNUM,VMIEN,'$GET(VFNEW))
+20 IF 'RET
SET RET=VMIEN
+21 ;Add in the Qualifier multiple, QUALS array = N array $P22, $P23, $P24, etc.
+22 FOR I=1:1
SET QUAL=$PIECE(QUALS,U,I)
IF QUAL=""
QUIT
Begin DoDot:1
+23 SET QIEN="+"_I_","_VMIEN_","
+24 NEW FDA,ERR,IEN2
+25 ; [5] QUALIFIER (Multiple-9000010.015)
SET FDA(FNUM_5,QIEN,.01)=QUAL
+26 DO UPDATE^DIE(,"FDA","IEN2","ERR")
+27 IF $GET(ERR("DIERR",1))
SET RET=-ERR("DIERR",1)_U_ERR("DIERR",1,"TEXT",1)
End DoDot:1
+28 QUIT RET
HOOK(IEN,VMIEN) ;Hook it back to the parent
+1 IF +VMIEN
Begin DoDot:1
+2 NEW SIEN,FDA,ERR,IEN2
+3 IF DEL="@"
SET VMIEN="@"
+4 SET SIEN=IEN_","_VFIEN_","
+5 SET FDA(9000010.6315,SIEN,.2)=VMIEN
+6 DO UPDATE^DIE(,"FDA","IEN2","ERR")
End DoDot:1
+7 QUIT
+8 ; EIE V Measurement file entries for LKW or NSST
+9 ; VFIEN = V STROKE file ien VFIEN
+10 ; Flag the entry as Entered in Error
EIEVM(RET2,VFIEN) ;EP
+1 NEW VIEN,VMARR
+2 KILL VMARR
+3 SET VIEN=$PIECE($GET(^AUPNVSTR(VFIEN,0)),"^",3)
+4 IF $GET(VIEN)=""
SET RET=0
QUIT
+5 DO GETVM(VIEN)
+6 ; no VM entries for Visit IEN found
IF RET=0
QUIT RET
+7 NEW VMFIEN
+8 SET VMFIEN=""
+9 FOR
SET VMFIEN=$ORDER(VMARR(VMFIEN))
IF VMFIEN=""
QUIT
Begin DoDot:1
+10 NEW INP
+11 ; Reason = 4 = INVALID RECORD (default)
SET INP=VMFIEN_"^4"
+12 DO SETEIE
End DoDot:1
+13 QUIT
+14 ; Return V Measurement file entries for visit VIEN
+15 ; Input = VIEN
+16 ; Returns: 1/entries in VMARR array, 0/No entries found
+17 ; Screen for TYPE = LKW or NSST entries
+18 ; For NSST entries field match criteria:
+19 ; [NIHDAT] .02 EVENT DATE/TIME (D), [0;2] = [VITALDT] .07 DATE/TIME VITALS ENTERED (D), [0;7]
+20 ; [NIHVALUE] .19 TOTAL STROKE SCORE (NJ2,0),[0;19] = [VALUE] .04 VALUE (RFXO), [0;4]
GETVM(VIEN) ;
+1 NEW CNT,VMIEN,VALUE,VITALDT
+2 IF 'VIEN
SET VMARR(1)=$$ERR^BGOUTL(1002)
QUIT
+3 SET (CNT,VMIEN,RET)=0
+4 FOR
SET VMIEN=$ORDER(^AUPNVMSR("AD",VIEN,VMIEN))
IF 'VMIEN
QUIT
Begin DoDot:1
+5 NEW X,USR,DAT,TYPE,TYPENM
+6 SET X=$GET(^AUPNVMSR(VMIEN,0))
+7 IF X=""
QUIT
+8 SET VALUE=$PIECE(X,"^",4)
SET VITALDT=$PIECE($GET(^AUPNVMSR(VMIEN,12)),"^",1)
+9 SET DAT=+$GET(^(12))
SET USR=+$PIECE($GET(^(12)),U,4)
+10 SET TYPE=+X
+11 SET TYPENM=$PIECE($GET(^AUTTMSR(TYPE,0)),U)
+12 IF TYPENM=""
QUIT
+13 ; only LKW and NSST records
IF TYPENM'="LKW"&(TYPENM'="NSST")
QUIT
+14 NEW NAME
+15 SET NAME=$PIECE($GET(^VA(200,USR,0)),U)
+16 IF 'DAT
SET DAT=+$GET(^AUPNVSIT(VIEN,0))
+17 IF TYPENM="NSST"
Begin DoDot:2
+18 NEW NIHDT,NIHREC
+19 SET NIHDT=0
+20 FOR
SET NIHDT=$ORDER(^AUPNVSTR(VFIEN,15,"B",NIHDT))
IF 'NIHDT
QUIT
Begin DoDot:3
+21 SET NIHREC=0
SET NIHREC=$ORDER(^AUPNVSTR(VFIEN,15,"B",NIHDT,NIHREC))
+22 NEW NIHNODE,NIHVALUE,NIHDAT
+23 SET NIHNODE=$GET(^AUPNVSTR(VFIEN,15,NIHREC,0))
SET NIHDAT=$EXTRACT($PIECE(NIHNODE,"^",2),1,12)
SET NIHVALUE=$PIECE(NIHNODE,"^",19)
+24 IF NIHDAT'=VITALDT!(NIHVALUE'=VALUE)
QUIT
+25 ; NSST ENTRY
SET VMARR(VMIEN)=TYPENM_U_DAT_U_$$ISLOCKED^BEHOENCX(VIEN)
End DoDot:3
End DoDot:2
+26 ; LKW ENTRY
IF TYPENM="LKW"
SET VMARR(VMIEN)=TYPENM_U_DAT_U_$$ISLOCKED^BEHOENCX(VIEN)
+27 SET CNT=CNT+1
End DoDot:1
+28 IF $DATA(VMARR)
SET RET=1
+29 QUIT RET
+30 ; Update EIE for V Measurement file entry
SETEIE ;
+1 NEW FDA,REASON,VFIEN
+2 SET VFIEN=$PIECE(INP,U)
+3 SET REASON=$PIECE(INP,U,2)
+4 ; Input out of range
IF REASON<0
IF REASON>4
SET RET="-1^Reason EIE out of range"
QUIT
+5 ; Missing input data
IF VFIEN=""
SET RET=$$ERR^BGOUTL(1008)
QUIT
+6 ; Item not found
IF '$DATA(^AUPNVMSR(VFIEN))
SET RET=$$ERR^BGOUTL(1035)
QUIT
+7 SET FDA=$NAME(FDA(9000010.01,VFIEN_","))
+8 SET @FDA@(2)=1
+9 SET @FDA@(3)=DUZ
+10 SET RET=$$UPDATE^BGOUTL(.FDA,,VFIEN)
+11 NEW EIEN
SET EIEN="+1,"_VFIEN_","
+12 NEW FDA,ERR,IEN2
+13 ;S FDA($$FNUM_4,EIEN,.01)=REASON
+14 SET FDA(9000010.014,EIEN,.01)=REASON
+15 DO UPDATE^DIE(,"FDA","IEN2","ERR")
+16 IF $GET(ERR("DIERR",1))
SET RET=-ERR("DIERR",1)_U_ERR("DIERR",1,"TEXT",1)
+17 IF RET=""
SET RET=1
+18 QUIT
+19 ;Return V File #
FNUM(RET,INP) SET RET=9000010.63
+1 QUIT RET
+2 ;
DMULT(RET,VFIEN,SUBIEN,NODE) ; Delete a multiple entry from V file
+1 IF $GET(VFIEN)=""!($GET(SUBIEN)="")!($GET(NODE)="")
SET RET="-1^""missing delete multiple parameter"""
QUIT RET
+2 NEW ERR,DA,DIK
+3 SET ERR=""
+4 SET RET=""
+5 SET DA(1)=VFIEN
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 QUIT
