Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGOVUPD

BGOVUPD.m

Go to the documentation of this file.
  1. BGOVUPD ; IHS/MSC/MGH - Manage V UPDATE/REVIEWED file ;09-Apr-2012 14:25;DU
  1. ;;1.1;BGO COMPONENTS;**8,10,11**;Mar 20, 2007;Build 3
  1. ; Get entries for a patient and either a VIEN Or a date
  1. ; INP = Patient IEN [1]^ VIEN [2] ^Start DT [3] ^End dt [4]
  1. ; .RET returned as a list of records in the format:
  1. ; IEN[1] ^ ACTION [2] ^ Action Type [3] ^Visit Date [4] ^Date/time entered [5] ^ entered by [6] ^Event dt/time [7] ^ encounter provider [8]
  1. GET(RET,INP) ;EP
  1. N DFN,END,LRN,VFIEN,TYPE,CNT,VDT,VIEN,IEN,VDATE,UDATE,START
  1. S RET=$$TMPGBL^BGOUTL
  1. S DFN=+INP
  1. S VIEN=$P(INP,U,2)
  1. S START=$P(INP,U,3),END=$P(INP,U,4)
  1. S (TYPE,CNT)=0
  1. I +VIEN D
  1. .S IEN="" F S IEN=$O(^AUPNVRUP("AD",VIEN,IEN)) Q:IEN="" D CNT(IEN)
  1. E D
  1. .S:'START START=DT+1
  1. .S:START<END X=START,START=END,END=X
  1. .S START=9999999-$S(START#1:START,1:START+.9),END=9999999-END
  1. .F S START=$O(^AUPNVRUP("AE",DFN,START)) Q:'START!(START>END) D
  1. ..S TYPE="" F S TYPE=$O(^AUPNVRUP("AE",DFN,START,TYPE)) Q:TYPE="" D
  1. ...S IEN="" F S IEN=$O(^AUPNVRUP("AE",DFN,START,TYPE,IEN)) Q:IEN="" D CNT(IEN)
  1. Q
  1. CNT(IEN) ;Put the data in to array for return
  1. N TYPE,VDATE,DENT,VISIT,ETYPE,ATYPE,ENTBY,EVDT,ENCPRV,ZERO,ONE,TWELVE,X
  1. Q:$D(^AUPNVRUP(IEN,2)) ;Skip entries that are in error
  1. S TYPE=$P($G(^AUPNVRUP(IEN,0)),U,1)
  1. S ETYPE=$$GET1^DIQ(9000010.54,IEN,.01)
  1. S ATYP=$S(ETYPE["ALLERG":"A",ETYPE["PROBLEM":"P",ETYPE["MEDICATION":"M",1:"")
  1. S VDATE=$$GET1^DIQ(9000010.54,IEN,.03)
  1. S DENT=$$GET1^DIQ(9000010.54,IEN,1.01)
  1. S ENTBY=$$GET1^DIQ(9000010.54,IEN,1.02)
  1. S EVDT=$$GET1^DIQ(9000010.54,IEN,1201)
  1. S ENCPRV=$$GET1^DIQ(9000010.54,IEN,1204)
  1. S CNT=CNT+1
  1. S @RET@(CNT)=IEN_U_TYPE_"~"_ETYPE_U_ATYP_U_VDATE_U_DENT_U_ENTBY_U_EVDT_U_ENCPRV
  1. Q
  1. ; Add/edit entry in update/reviewed file
  1. ; INP = Update Type IEN [1] ^ V file IEN [2] ^ DFN [3] ^ Visit String [4] ^ Evnt day/time[5] ^ Provider IEN [6] ^ Delete [7] ^ Delete Reason~free text reason [8]
  1. ; RET= IEN or error message [1] ^ VISIT IEN [2] ^ IEN OF REVIEW MESSAGE IF ADDED AUTOMATICALLY [3]
  1. SET(RET,INP) ;EP
  1. N VIEN,TYPE,VSTR,PRV,VFIEN,VFNEW,EVDT,FNUM,FDA,ATYP,ETYP,DFN,ACTION,UPDATE,REV
  1. S FNUM=$$FNUM
  1. S TYPE=+INP
  1. I 'TYPE S RET=$$ERR^BGOUTL(1008) Q
  1. ;S VFIEN=$P(INP,U,2)
  1. ;For now, all SETS are new entries
  1. S VFIEN=0
  1. S DFN=$P(INP,U,3)
  1. I $P(INP,U,7)="D" D EIE(INP) Q
  1. S VFNEW='VFIEN
  1. S VSTR=$P(INP,U,4)
  1. S EVDT=$P(INP,U,5)
  1. S PRV=$P(INP,U,6)
  1. I VSTR="" S RET="-1^You must first create a visit context to store data" Q
  1. ;If a visit has not yet been created, create the visit
  1. S VIEN=$$VSTR2VIS^BEHOENCX(DFN,VSTR,1,PRV)
  1. I VIEN=0 S RET="-1^No visit created" Q
  1. I 'VFIEN D Q:'VFIEN
  1. .D VFNEW^BGOUTL2(.RET,FNUM,TYPE,VIEN)
  1. .S:RET>0 VFIEN=RET,RET=""
  1. S UPDATE=$$FILEDATA(VFIEN)
  1. D:'UPDATE VFEVT^BGOUTL2(FNUM,VFIEN,'VFNEW)
  1. S:'UPDATE RET=VFIEN_U_VIEN
  1. ;If this is an update, auto file the review data
  1. S ETYP=$P($G(^AUTTCRA(TYPE,0)),U,1)
  1. S ACTION=$S(ETYP["UPDATED":1,1:0)
  1. S ATYP=$S(ETYP["ALLERG":"A",ETYP["PROBLEM":"P",ETYP["MEDICATION":"M",1:"")
  1. I +ACTION D
  1. .I ATYP="A" S TYPE=$O(^AUTTCRA("B","ALLERGY LIST REVIEWED",""))
  1. .I ATYP="P" S TYPE=$O(^AUTTCRA("B","PROBLEM LIST REVIEWED",""))
  1. .I ATYP="M" S TYPE=$O(^AUTTCRA("B","MEDICATION LIST REVIEWED",""))
  1. .S VFIEN=0
  1. .D VFNEW^BGOUTL2(.REV,FNUM,TYPE,VIEN)
  1. .S:REV>0 VFIEN=REV,REV=""
  1. .Q:'VFIEN
  1. .S UPDATE=$$FILEDATA(VFIEN)
  1. .S:'UPDATE RET=RET_U_VFIEN
  1. ;If this is an allergy update, check for inaccessible entries
  1. S DFN=$P($G(^AUPNVRUP(VFIEN,0)),U,2)
  1. I ATYP="A" D
  1. .D CKIN^BEHOARMU(DFN)
  1. .D FIREEVT^BEHOART(DFN,2,"")
  1. Q
  1. FILEDATA(TYPE) ;Store the data
  1. N RET
  1. S FDA=$NA(FDA(FNUM,VFIEN_","))
  1. S @FDA@(1.01)="N"
  1. S @FDA@(1.02)="`"_DUZ
  1. I EVDT="" S EVDT="N"
  1. S @FDA@(1201)=EVDT
  1. ;patch 10 set duz to encounter provider
  1. ;I PRV="" S PRV=DUZ
  1. S @FDA@(1204)="`"_DUZ
  1. ;IHS/MSC/MGH patch 11 added new fields
  1. S @FDA@(1216)="N"
  1. S @FDA@(1217)="`"_DUZ
  1. S @FDA@(1218)="N"
  1. S @FDA@(1219)="`"_DUZ
  1. S RET=$$UPDATE^BGOUTL(.FDA,"E")
  1. I RET,VFNEW,$$DELETE^BGOUTL(FNUM,VFIEN)
  1. Q RET
  1. EIE(INP) ;Mark this entry as entered in error
  1. N REASON,VFIEN,FNUM,TYPE,VFIEN
  1. S FNUM=$$FNUM
  1. S TYPE=+INP
  1. S VFIEN=$P(INP,U,2)
  1. I 'VFIEN D ERR^BGOUTL(1059) Q
  1. S REASON=$P($P(INP,U,7),"~",1)
  1. S FDA=$NA(FDA(FNUM,VFIEN_","))
  1. S @FDA@(2.01)=1
  1. S @FDA@(2.02)="`"_DUZ
  1. S REASON=$S(REASON="DUPLICATE":"D",REASON="D":"D",REASON="ENTERED IN ERROR":"E",REASON="E":"E",REASON="OTHER":"O",1:"O")
  1. S @FDA@(2.03)=REASON
  1. I REASON="O" S @FDA@(2.04)=$P($P(INP,U,7),"~",2)
  1. S RET=$$UPDATE^BGOUTL(.FDA,"E")
  1. D:'RET VFEVT^BGOUTL2(FNUM,VFIEN,2)
  1. S:'RET RET=VFIEN
  1. Q
  1. ; Return V File #
  1. FNUM() Q 9000010.54