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

BGOVCPT.m

Go to the documentation of this file. 
  1. BGOVCPT ; IHS/BAO/TMD - Manage V CPT ;31-Mar-2016 04:49;du
  1.  ;;1.1;BGO COMPONENTS;**1,3,4,5,6,8,9,11,13,14,16,17,18,20**;Mar 20, 2007;Build 2
  1.  ;---------------------------------------------
  1. TIUSTR() ;EP
  1.  N X,Y
  1.  S X=$$GETVAR^CIANBUTL("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
  1.  Q:X="" " "
  1.  S X=$$VSTR2VIS^BEHOENCX(DFN,X)
  1.  Q:X<1 " "
  1.  D GET(.X,DFN_"^^"_X_"^^1")
  1.  S Y=$G(@X@(1))
  1.  K @X
  1.  Q $S(Y<0:"",1:Y)
  1.  ; Return IEN of a CPT code
  1. GETIEN(RET,CPT) ;EP
  1.  S RET=$O(^ICPT("BA",$G(CPT)_" ",0))
  1.  Q
  1.  ; Return vaccine IEN associated with specified CPT IEN
  1. IMMCK(RET,CPTIEN) ;EP
  1.  N X
  1.  S RET="",X=0
  1.  F  S X=$O(^AUTTIMM(X)) Q:'X  I $P(^(X,0),U,11)=CPTIEN,'$P(^(0),U,7) Q
  1.  S:X RET=X_U_$P(^AUTTIMM(X,0),U,2)
  1.  Q
  1.  ; Return VCPT entries by patient or by visit
  1.  ;   INP = Patient IEN ^ Max ^ Visit IEN ^ Type ^ Format (0-detailed,1-tiu list)
  1.  ;   Returned as a list of records in the format:
  1.  ;     Visit Date [1] ^ Fac IEN [2] ^ Fac Name [3] ^ CPT [4] ^ CPT name [5] ^ Narrative [6] ^ Dx [7] ^
  1.  ;     Prim [8] ^ Mod1 [9] ^ Mod2 [10] ^ V File IEN [11] ^ Visit IEN [12] ^ CPT IEN [13] ^ Quantity [14] ^
  1.  ;     Provider Name [15] ^ Tran Code IEN [16] ^ ICD0 IEN [17] ^ Visit Locked [18] ^ V File [19]
  1. GET(RET,INP) ;EP
  1.  N CNT,BGO,REC,COD,TRANIEN,ICD0IEN,QTY,DX,IEN,DFN,VISITIEN,FORMAT,TYP,MAX,VIEN,MOD1,MOD2
  1.  N CPT,CPTIEN,ITEMNAME,PNAR,TAX,PRIM,PRV,CODE,VF,ICDCNT,SCODE,ICDARRY,V2,V3,MATCH,X,Z,BHSCPT2
  1.  S RET=$$TMPGBL^BGOUTL
  1.  S CNT=0,ICDCNT=0
  1.  S DFN=+INP
  1.  Q:'DFN
  1.  S MAX=$P(INP,U,2)
  1.  S:'MAX MAX=9999
  1.  S VISITIEN=+$P(INP,U,3)
  1.  S TYP=$$UP^XLFSTR($P(INP,U,4))
  1.  S FORMAT=+$P(INP,U,5)
  1.  S IEN=0
  1.  D G1:VISITIEN,G0:'VISITIEN
  1.  Q
  1.  ; By patient
  1. G0 I TYP'="DENTAL" D
  1.  .F  S IEN=$O(^AUPNVCPT("C",DFN,IEN)) Q:'IEN  Q:CNT>MAX  D CPTBLD(1)
  1.  I TYP="DENTAL" D
  1.  .F  S IEN=$O(^AUPNVDEN("AC",DFN,IEN)) Q:'IEN  Q:CNT>MAX  D DENBLD
  1.  I TYP="SURGICAL"!(TYP="ALL") D
  1.  .F  S IEN=$O(^AUPNVPRC("AC",DFN,IEN)) Q:'IEN  Q:CNT>MAX  D PRCBLD(1)
  1.  Q
  1.  ; By visit
  1. G1 I TYP="DENTAL" D
  1.  .F  S IEN=$O(^AUPNVDEN("AD",VISITIEN,IEN)) Q:'IEN  Q:CNT>MAX  D DENBLD
  1.  F  S IEN=$O(^AUPNVCPT("AD",VISITIEN,IEN)) Q:'IEN  Q:CNT>MAX  D CPTBLD(0)
  1.  F  S IEN=$O(^AUPNVTC("AD",VISITIEN,IEN)) Q:'IEN  Q:CNT>MAX  D TRANBLD
  1.  F  S IEN=$O(^AUPNVPRC("AD",VISITIEN,IEN)) Q:'IEN  Q:CNT>MAX  D PRCBLD(0)
  1.  Q
  1.  ; VCPT
  1. CPTBLD(SRCH) ;EP- Find CPTs
  1.  D INIT("CPT")
  1.  S REC=$G(^AUPNVCPT(IEN,0))
  1.  Q:REC=""
  1.  I FORMAT D  Q
  1.  .S CPTIEN=$P(REC,U) Q:CPTIEN=""
  1.  .I CPTIEN>99200,CPTIEN<99500 Q
  1.  .S PNAR=$P($G(^ICPT(CPTIEN,0)),U,2)
  1.  .I $P(REC,U,4) S PNAR=$P($G(^AUTNPOV($P(REC,U,4),0)),U)
  1.  .S CNT=CNT+1
  1.  .S ^TMP("BGOVCPT",$J,1)=$S(CNT=1:"",1:^TMP("BGOVCPT",$J,1)_"; ")_PNAR
  1.  S CPTIEN=$P(REC,U) Q:CPTIEN=""
  1.  S VIEN=$P(REC,U,3)
  1.  S V2=$P($G(^AUPNVSIT(VIEN,0)),U)
  1.  S PNAR=$P(REC,U,4)
  1.  S DX=$P(REC,U,5)
  1.  S QTY=$P(REC,U,16)
  1.  S PRIM=$P(REC,U,7)
  1.  I $G(DUZ("AG"))="I" D  ;P6
  1.  .S MOD1=$P(REC,U,8)
  1.  .S MOD2=$P(REC,U,9)
  1.  E  D
  1.  .N X
  1.  .S X=+$O(^AUPNVCPT(IEN,1,0)),MOD1=$P($G(^(X,0)),U)
  1.  .S X=+$O(^AUPNVCPT(IEN,1,X)),MOD2=$P($G(^(X,0)),U)
  1.  S PRV=$P($G(^AUPNVCPT(IEN,12)),U,4)
  1.  S CODE=$P($G(^ICPT(CPTIEN,0)),U)
  1.  Q:CODE=""
  1.  ;IHS/MSC/MGH Added check for taxonomy to display surgical procedures Patch 11
  1.  S TAX=$O(^ATXAX("B","APCH HS MAJOR PROCEDURE CPTS",0))
  1.  I TYP="SURGICAL",((CODE<10000)&(CODE'="00099"))!(CODE>69999) Q
  1.  ;IHS/MSC/MGH Patch 18
  1.  I TYP="SURGICAL",SRCH=1,'$$ICD^ATXAPI(CODE,TAX,1) Q  ;Not a CPT on this component
  1.  I TYP="MEDICAL",CODE<90000!(CODE>99999) Q
  1.  I TYP="ANESTHESIA",CODE>9999!(+CODE=0)!(CODE="00099") Q
  1.  I TYP="RADIOLOGY",CODE<70000!(CODE>79999) Q
  1.  I TYP="LABORATORY",CODE<80000!(CODE>89999) Q
  1.  I TYP="MISCELLANEOUS",CODE'?1A4N Q
  1.  S ITEMNAME=$P($G(^ICPT(CPTIEN,0)),U,2)
  1.  D ARRAY
  1.  ;MSC/IHS/MGH If there is a corresponding ICD0 code, save it for lookup later
  1.  I $D(^ICPT(CPTIEN,"ICD",0)) D
  1.  .S SCODE=0 F  S SCODE=$O(^ICPT(CPTIEN,"ICD",SCODE)) Q:SCODE=""!(SCODE="B")  D
  1.  ..S ICDARRY(SCODE)=CODE_"^"_V2
  1.  Q
  1.  ; Build dental history
  1. DENBLD N ADA
  1.  D INIT("DEN")
  1.  S REC=$G(^AUPNVDEN(IEN,0))
  1.  Q:REC=""
  1.  S ADA=$P(^AUTTADA(+REC,0),U)
  1.  Q:'ADA
  1.  S CPTIEN=$O(^ICPT("B",ADA,0))
  1.  Q:'CPTIEN
  1.  S CODE=$P($G(^ICPT(CPTIEN,0)),U)
  1.  Q:CODE=""
  1.  S ITEMNAME=$P($G(^ICPT(CPTIEN,0)),U,2)
  1.  S VIEN=$P(REC,U,3)
  1.  Q:VIEN=""
  1.  S PRV=$P($G(^AUPNVDEN(IEN,12)),U,4)
  1.  D ARRAY
  1.  Q
  1.  ; Interface with V TRANSACTION CODE file
  1. TRANBLD D INIT("TC")
  1.  S REC=$G(^AUPNVTC(IEN,0))
  1.  Q:REC=""
  1.  S TRANIEN=$P(REC,U)
  1.  Q:TRANIEN=""
  1.  S CODE=$P($G(^BCMTCF(TRANIEN,0)),U)
  1.  S VIEN=$P(REC,U,3)
  1.  S ITEMNAME=$P($G(^BCMTCF(TRANIEN,0)),U,7)
  1.  S MOD1=$P(REC,U,8)
  1.  S PRV=$P($G(^AUPNVTC(IEN,12)),U,4)
  1.  D ARRAY
  1.  Q
  1.  ; Interface with V PROCEDURE file
  1. PRCBLD(SRCH) N SKIP,X,Y,ICODE
  1.  D INIT("PRC")
  1.  S REC=$G(^AUPNVPRC(IEN,0))
  1.  Q:REC=""
  1.  S ICD0IEN=$P(REC,U)
  1.  Q:ICD0IEN=""
  1.  S VIEN=$P(REC,U,3)
  1.  S V3=$P($G(^AUPNVSIT(VIEN,0)),U)
  1.  S DX=$P(REC,U,5)
  1.  S PNAR=$P(REC,U,4)
  1.  S PRV=$P($G(^AUPNVPRC(IEN,12)),U,4)
  1.  ;IHS/MSC/MGH Changed the 2 to a 1 to return the proper field Patch 17
  1.  I $$AICD^BGOUTL2 S CODE=$P($$ICDOP^ICDEX(ICD0IEN,V3,"","I"),U,2)
  1.  E  S CODE=$P($G(^ICD0(ICD0IEN,0)),U)
  1.  Q:CODE=""
  1.  ; Do not include ICD procedures that correspond to CPT procedures
  1.  S (X,SKIP)=0
  1.  ;IHS/MSC/MGH Use the saved array to check for matching codes and dates
  1.  I 'VISITIEN D
  1.  .S ICODE=0 F  S ICODE=$O(ICDARRY(ICODE)) Q:ICODE=""  D
  1.  ..I ICD0IEN=ICODE&($P($G(ICDARRY(ICODE)),U,2)=V3) S SKIP=1 Q
  1.  E  D
  1.  .F  S X=$O(^ICPT("I",ICD0IEN,X)) Q:'X  D  Q:SKIP
  1.  ..S Y=0
  1.  ..F  S Y=$O(^AUPNVCPT("AD",VISITIEN,Y)) Q:'Y  I +^AUPNVCPT(Y,0)=X S SKIP=1 Q
  1.  Q:SKIP
  1.  I TYP="SURGICAL" D  Q:SKIP
  1.  .S SKIP=1
  1.  .;Patch 16 changed lookup
  1.  .I SRCH,$$ICD^ATXAPI(ICD0IEN,$O(^ATXAX("B","APCH MINOR SURGICAL PROCS",0)),0) Q
  1.  .;Q:CODE\1>85
  1.  .;Q:CODE=69.7
  1.  .;Q:CODE\1=23
  1.  .;Q:CODE\1=24
  1.  .S SKIP=0
  1.  I $$AICD^BGOUTL2 S ITEMNAME=$P($$ICDOP^ICDEX(ICD0IEN,V3,"","I"),U,5)
  1.  E  S ITEMNAME=$P($$ICDOP^ICDCODE(ICD0IEN,V3),U,5)
  1.  ;S ITEMNAME=$P($G(^ICD0(ICD0IEN,0)),U,4)
  1.  D ARRAY
  1.  Q
  1. INIT(X) S (CPT,ITEMNAME,PNAR,DX,PRIM,MOD1,MOD2,VIEN,CPTIEN,QTY,PRV,TRANIEN,ICD0IEN)="",VF=X
  1.  Q
  1. ARRAY N F,V,VDATE,FAC,FACNAM
  1.  S F=$P($G(^AUPNVSIT(VIEN,0)),U,6)
  1.  S FAC=$P($G(^AUTTLOC(+F,0)),U,10)
  1.  S FACNAM=$P($G(^AUTTLOC(+F,0)),U)
  1.  S FACNAM=$P($G(^DIC(4,+FACNAM,0)),U)
  1.  S:$P($G(^AUPNVSIT(VIEN,21)),U)'="" FACNAM=$P(^(21),U)
  1.  S V=$P($G(^AUPNVSIT(VIEN,0)),U)
  1.  Q:V=""
  1.  S VDATE=$$FMTDATE^BGOUTL(V)
  1.  S:PNAR PNAR=$P($G(^AUTNPOV(PNAR,0)),U)
  1.  S:PNAR="" PNAR=ITEMNAME
  1.  ;S:DX DX=$P($G(^ICD9(DX,0)),U,3) ;DKA Patch 13
  1.  I DX D
  1.  .I $$AICD^BGOUTL2 S DX=$P($$ICDDX^ICDEX(DX,VDATE,"","I"),U,4)
  1.  .E  S DX=$P($$ICDDX^ICDCODE(DX,VDATE),U,4)
  1.  S:PRV PRV=$P($G(^VA(200,PRV,0)),U)
  1.  S:MOD1 MOD1=MOD1_"~"_$P($G(@$$MODGBL@(MOD1,0)),U,2)
  1.  S:MOD2 MOD2=MOD2_"~"_$P($G(@$$MODGBL@(MOD2,0)),U,2)
  1.  S CNT=CNT+1
  1.  S @RET@(CNT)=VDATE_U_FAC_U_FACNAM_U_CODE_U_ITEMNAME_U_PNAR_U_DX_U_PRIM_U_MOD1_U_MOD2_U_IEN_U_VIEN_U_CPTIEN_U_QTY_U_PRV_U_TRANIEN_U_ICD0IEN_U_$$ISLOCKED^BEHOENCX(VIEN)_U_VF
  1.  Q
  1.  ; Returns CPT modifier global reference
  1.  ;IHS/MSC/MGH Changed for code set versioning
  1. MODGBL() Q $S($$CSVACT^BGOUTL2():"^DIC(81.3)",$G(DUZ("AG"))="I":"^AUTTCMOD",1:"^DIC(81.3)")  ;P6
  1.  ; Delete a V CPT, V Procedure, or V Transaction Code entry.
  1.  ;  INP = IEN ^ Type
  1. DEL(RET,INP) ;EP
  1.  N IEN,TYP,FNUM
  1.  S IEN=+INP,RET=""
  1.  I 'IEN S RET=$$ERR^BGOUTL(1008) Q
  1.  S TYP=$P(INP,U,2)
  1.  S:TYP="" TYP="CPT"
  1.  I TYP="CPT" D  Q:RET<0
  1.  .N CPTIEN,ICD0IEN,VIEN,PRCIEN,X
  1.  .S X=$G(^AUPNVCPT(IEN,0)),CPTIEN=+X,VIEN=+$P(X,U,3),ICD0IEN=0
  1.  .F  S ICD0IEN=$O(^ICPT(CPTIEN,"ICD",ICD0IEN)) Q:'ICD0IEN  D
  1.  ..S PRCIEN=0
  1.  ..F  S PRCIEN=$O(^AUPNVPRC("AD",VIEN,PRCIEN)) Q:'PRCIEN  D  Q:RET<0
  1.  ...D:+$G(^AUPNVPRC(PRCIEN,0))=ICD0IEN DEL(.RET,PRCIEN_"^PRC")
  1.  S FNUM=+$P($G(@("^AUPNV"_TYP_"(0)")),U,2)
  1.  I 'FNUM S RET=$$ERR^BGOUTL(1072,TYP)
  1.  E  D VFDEL^BGOUTL2(.RET,FNUM,IEN)
  1.  Q
  1.  ; Set VCPT quantity
  1.  ;  INP = VCPT IEN ^ Quantity
  1. SETQTY(RET,INP) ;EP
  1.  D SETVAL(.RET,+INP,$P(INP,U,2),.16)
  1.  Q
  1.  ; Set VCPT diagnosis
  1.  ;  INP = VCPT IEN ^ Diagnosis IEN
  1. SETDX(RET,INP) ;EP
  1.  D SETVAL(.RET,+INP,"`"_$P(INP,U,2),.05)
  1.  Q
  1.  ; Set a value
  1. SETVAL(RET,IEN,VAL,FLD) ;
  1.  N FDA
  1.  S FDA($$FNUM,IEN_",",FLD)=VAL
  1.  S RET=$$UPDATE^BGOUTL(.FDA,"E")
  1.  D:'RET VFEVT^BGOUTL2($$FNUM,IEN,1)
  1.  Q
  1.  ; Checks CPT code for validity
  1.  ;  CPTIEN = CPT IEN
  1.  ;  ACTDT  = Active Date
  1.  ;  Returns null if OK, or -n^error text
  1. CHKCPT(CPTIEN,ACTDT,IEN) ;EP
  1.  N RET,X
  1.  S RET="",IEN=$G(IEN)
  1.  S ACTDT=$G(ACTDT,DT)
  1.  I $$CSVACT^BGOUTL2("ICPTCOD") D
  1.  .;IHS/MSC/MGH Added for HOTFIX to make sure we have the IEN and not the code
  1.  .I +IEN S CPTIEN=$$CODEN^ICPTCOD(CPTIEN)
  1.  .S X=$$CPT^ICPTCOD(CPTIEN,ACTDT)
  1.  .I X<0 S RET=$$ERR^BGOUTL(1073)
  1.  .E  I '$P(X,U,7) S RET=$$ERR^BGOUTL(1074)
  1.  E  D
  1.  .N DELDT
  1.  .S X=$G(^ICPT(CPTIEN,0))
  1.  .I X="" S RET=$$ERR^BGOUTL(1073) Q
  1.  .I $P(X,U,4) S RET=$$ERR^BGOUTL(1074) Q
  1.  .S DELDT=$P(X,U,7)
  1.  .I DELDT D
  1.  ..S:'ACTDT ACTDT=DT
  1.  ..S:$$FMDIFF^XLFDT(ACTDT,DELDT)>-1 RET=$$ERR^BGOUTL(1075)
  1.  Q RET
  1.  ; Add/edit a VCPT entry
  1.  ;  INP = Visit IEN [1] ^ CPT IEN [2] ^ Patient IEN [3] ^ Event Date [4] ^ Quantity [5] ^ Diagnosis [6] ^
  1.  ;        Modifier #1 [7] ^ Provider IEN [8] ^ Principal [9] ^ V File IEN [10] ^ Narrative [11] ^ Modifier #2 [12] ^
  1.  ;        Location IEN [13] ^ Outside Location [14] ^ Historical [15] ^ ICD Procedure Flag [16] ^ No Dups [17]
  1.  ; .RET = VCPT IEN or -n^error text if not successful
  1. SET(RET,INP) ;EP
  1.  N VIEN,X,APCDALVR,DFN,TYPE,VFIEN,QTY,DX,MOD1,PRV,PRIN,NARR,MOD2,EVNTDT,LOCIEN,OUTLOC,HIST
  1.  N DELDT,ICD0FLG,NODUP,VCAT,FDA,FNUM,VFNEW,IEN,CHKDT,APCDOVR
  1.  S RET="",FNUM=$$FNUM
  1.  S VIEN=+INP
  1.  S TYPE=$P(INP,U,2)
  1.  S DFN=$P(INP,U,3)
  1.  S EVNTDT=$$CVTDATE^BGOUTL($P(INP,U,4))
  1.  I EVNTDT="" S EVNTDT=$P($G(^AUPNVSIT(VIEN,0)),U,1)
  1.  I EVNTDT="" S EVNTDT=$$NOW^XLFDT
  1.  S QTY=$P(INP,U,5)
  1.  S DX=$P(INP,U,6)
  1.  S MOD1=$P(INP,U,7)
  1.  S PRV=$P(INP,U,8)
  1.  S PRIN=$P(INP,U,9)
  1.  S VFIEN=$P(INP,U,10)
  1.  S VFNEW='VFIEN
  1.  S RET=$$FNDNARR^BGOUTL2($P(INP,U,11))
  1.  Q:RET<0
  1.  S NARR=$S(RET:"`"_RET,1:""),RET=""
  1.  S MOD2=$P(INP,U,12)
  1.  S LOCIEN=$P(INP,U,13)
  1.  S OUTLOC=$P(INP,U,14)
  1.  S HIST=$P(INP,U,15)
  1.  ;IHS/MSC/MGH per Susan Richards this lookup is no longer supported
  1.  ;S ICD0FLG=$P(INP,U,16)
  1.  S NODUP=$P(INP,U,17)
  1.  I 'VIEN,'HIST S RET=$$ERR^BGOUTL(1002) Q
  1.  S VCAT=$P($G(^AUPNVSIT(VIEN,0)),U,7)
  1.  S:VCAT="E" HIST=1
  1.  S:'TYPE TYPE=+$O(^ICPT("B","00099",0))
  1.  ;IHS/MSC/MGH Dealing with old data, setting to first date
  1.  ;CHANGE DATE TO 2900101 PATCH 9
  1.  I EVNTDT<2890101 S CHKDT=2890101
  1.  E  S CHKDT=EVNTDT
  1.  S RET=$$CHKCPT(TYPE,CHKDT)
  1.  Q:RET<0
  1.  I HIST D  Q:RET<0
  1.  .S RET=$$MAKEHIST^BGOUTL(DFN,EVNTDT,$S($L(OUTLOC):OUTLOC,1:LOCIEN),VIEN)
  1.  .S:RET>0 VIEN=RET
  1.  S RET=$$CHKVISIT^BGOUTL(VIEN,DFN)
  1.  Q:RET
  1.  I 'VFIEN D  Q:RET
  1.  .I EVNTDT<DT S APCDOVR=1   ;IHS/MSC/MGH auto store if old data, Patch 9
  1.  .D VFNEW^BGOUTL2(.RET,FNUM,TYPE,VIEN,$S(NODUP:"CPT",1:""))
  1.  .S:RET>0 VFIEN=RET,RET=""
  1.  I PRIN="X"!(PRIN="") D
  1.  .S X=$$GETPRIN(VIEN)
  1.  .S PRIN=$S('X:"Y",X=VFIEN:"Y",1:"N")
  1.  S FDA=$NA(FDA(FNUM,VFIEN_","))
  1.  S @FDA@(.01)="`"_TYPE
  1.  S @FDA@(.04)=NARR
  1.  S @FDA@(.05)=$S(DX:"`"_DX,1:"@")
  1.  S @FDA@(.07)=PRIN
  1.  I $G(DUZ("AG"))="I" D  ;P6
  1.  .S @FDA@(.08)=$S(MOD1:"`"_MOD1,1:"@")
  1.  .S @FDA@(.09)=$S(MOD2:"`"_MOD2,1:"@")
  1.  E  D
  1.  .;IHS/MSC/MGH changes added patch 8
  1.  .I MOD1 I '$D(^AUPNVCPT(VFIEN,1,"B",MOD1)) D
  1.  ..S:MOD1 FDA(9000010.181,"?+1,"_VFIEN_",",.01)="`"_MOD1
  1.  .I MOD2 I '$D(^AUPNVCPT(VFIEN,2,"B",MOD2)) D
  1.  ..S:MOD2 FDA(9000010.181,"?+1,"_VFIEN_",",.01)="`"_MOD2
  1.  .S IEN(2)=1,IEN(3)=2
  1.  S @FDA@(.16)=$S(QTY>0:QTY,1:1)
  1.  S @FDA@(1201)="N"
  1.  ;S @FDA@(1204)="`"_$S(PRV:PRV,1:DUZ)  ;  PATCH 5
  1.  S @FDA@(1204)="`"_DUZ  ;PATCH 5
  1.  ;Patch 11 Set date entered
  1.  I VFNEW D
  1.  .S @FDA@(1216)="N"
  1.  .S @FDA@(1217)="`"_DUZ
  1.  ;Patch 11 Set last modified
  1.  S @FDA@(1218)="N"
  1.  S @FDA@(1219)="`"_DUZ
  1.  S RET=$$UPDATE^BGOUTL(.FDA,"E",.IEN)
  1.  I RET,VFNEW,$$DELETE^BGOUTL(FNUM,VFIEN)
  1.  Q:RET
  1.  S:PRIN="Y" RET=$$SETPRIN(VIEN,VFIEN)
  1.  ;MSC/IHS/MGH Call to create entry in procedure file is removed in patch 5
  1.  ;I 'RET,ICD0FLG D
  1.  ;.N VFIEN,PRCIEN,FNUM
  1.  ;.S PRCIEN=$O(^ICPT(TYPE,"ICD",0))
  1.  ;.Q:'PRCIEN
  1.  ;.S FNUM=9000010.08,VFIEN=0
  1.  ;.D VFNEW^BGOUTL2(.RET,FNUM,PRCIEN,VIEN)
  1.  ;.S:RET>0 VFIEN=RET,RET=""
  1.  ;.Q:RET
  1.  ;.S FDA=$NA(FDA(FNUM,VFIEN_","))
  1.  ;.S @FDA@(.04)=NARR
  1.  ;.S @FDA@(1201)=$S(EVNTDT:EVNTDT,1:"N")
  1.  ;.;S @FDA@(1204)="`"_$S(PRV:PRV,1:DUZ)  ;PATCH 5
  1.  ;.S @FDA@(1204)="`"_DUZ
  1.  ;.S RET=$$UPDATE^BGOUTL(.FDA,"E")
  1.  D:'RET VFEVT^BGOUTL2(FNUM,VFIEN,'VFNEW)
  1.  S:'RET RET=VFIEN
  1.  Q
  1.  ; Return IEN of principal VCPT entry
  1. GETPRIN(VIEN) ;
  1.  N VCPT
  1.  S VCPT=0
  1.  F  S VCPT=$O(^AUPNVCPT("AD",VIEN,VCPT)) Q:'VCPT  Q:$P($G(^AUPNVCPT(VCPT,0)),U,7)="Y"
  1.  Q VCPT
  1.  ; Set principal flag for specified entry, clearing all others
  1. SETPRIN(VIEN,VCPTIEN) ;
  1.  N VCPT,FDA
  1.  S VCPT=0
  1.  F  S VCPT=$O(^AUPNVCPT("AD",VIEN,VCPT)) Q:'VCPT  D
  1.  .S FDA($$FNUM,VCPT_",",.07)=$S(VCPT=VCPTIEN:"Y",1:"N")
  1.  Q $$UPDATE^BGOUTL(.FDA)
  1.  ; Add CPT code
  1. ADDCPT(CPT,ICD,VSIT,DFN,PRV) ;EP
  1.  N FDA,IEN,RET
  1.  S FDA=$NA(FDA($$FNUM,"+1,"))
  1.  S @FDA@(.01)=CPT
  1.  S @FDA@(.02)=DFN
  1.  S @FDA@(.03)=VSIT
  1.  S:$G(ICD) @FDA@(.05)=ICD
  1.  S @FDA@(.16)=1
  1.  S @FDA@(1201)=$$NOW^XLFDT
  1.  S @FDA@(1204)=$S(PRV:PRV,1:DUZ)
  1.  S RET=$$UPDATE^BGOUTL(.FDA,,.IEN)
  1.  D:'RET VFEVT^BGOUTL2($$FNUM,IEN(1),0)
  1.  Q RET
  1.  ; Return V File #
  1. FNUM() Q 9000010.18