BGOVPOV ; IHS/BAO/TMD - Visit POV maintenance ;09-Nov-2017 14:39;PLS
;;1.1;BGO COMPONENTS;**1,3,4,5,6,7,10,11,12,13,14,19,20,23**;Mar 20, 2007;Build 1
; Check for note signed by provider
; Patch 6 added check for asthma DX
; Patch 7 added bulletin for first time diagnosis
; Patch 13 added changes to store SNOMED into POV
; Patch 14 added changes for ICD-10 implementation
; Patch 20 added laterality data
; Patch 23 added fracture data
CKSIGNBY(RET,VIEN) ;EP
N X
S VIEN=+VIEN
Q:'VIEN
S RET=$$PRIPRV^BGOUTL(VIEN)
Q:RET<0
S RET=+RET
I RET'=DUZ S RET=$$ERR^BGOUTL(1089) Q
S RET="",X=0
F S X=$O(^TIU(8925,"V",VIEN,X)) Q:'X D Q:RET
.S:$P($G(^TIU(8925,X,15)),U,2)=DUZ RET=X
S:'RET RET=$$ERR^BGOUTL(1090)
Q
; Lookup ICD code
; INP = ICD code ^ Reference Date
; RET = Null if not found or ICD IEN^ICD Text
GETICD(RET,INP) ;EP
N IEN,ICD,CDT
S RET="",ICD=$P(INP,U),CDT=$P(INP,U,2)
;IHS/MSC/MSC Patch 12 changes
S IEN=$P($$ICDDX^ICDEX(ICD,CDT,"","E"),U,2)
S:IEN>0 RET=+IEN_U_$P(IEN,U,4)
Q
; Return ICD code given ICD IEN
; INP = ICD IEN ^ Reference Date
; RET = Null if not found or ICD Code^ICD Text
GETCODE(RET,INP) ;EP
N ICDIEN,CDT
S ICDIEN=$P(INP,U),CDT=$P(INP,U,2)
;Patch 12 changes
S RET=$$ICDDX^ICDEX(ICDIEN,CDT,"","I")
S RET=$S(RET<0:"",1:$P(RET,U,2)_U_$P(RET,U,4))
E S RET=""
Q
; Set primary/secondary for a POV
; INP = VPOV IEN ^ Primary/Secondary (P/S)
; For patch 13 changes made to store or unstore the primary DX SNOMED code
SETPRI(RET,INP,NOEVT) ;EP
N PRI,VFIEN,VIEN,FDA,X
S VFIEN=+INP
I 'VFIEN S RET=$$ERR^BGOUTL(1008) Q
S PRI=$P(INP,U,2)
I '$D(^AUPNVPOV(VFIEN,0)) S RET=$$ERR^BGOUTL(1091) Q
S VIEN=$P(^AUPNVPOV(VFIEN,0),U,3)
S FDA($$FNUM,VFIEN_",",.12)=PRI
I PRI="P" D
.S FDA($$FNUM,VFIEN_",",1103)=63161005 ;Set required code
.S X=0
.F S X=$O(^AUPNVPOV("AD",VIEN,X)) Q:'X D:X'=VFIEN
..I $P($G(^AUPNVPOV(X,0)),U,12)="P" D
...S FDA($$FNUM,X_",",.12)="S"
...S FDA($$FNUM,X_",",1103)="@"
E D
.S FDA($$FNUM,VFIEN_",",1103)="@"
S RET=$$UPDATE^BGOUTL(.FDA)
Q:RET
;I $$FIXVPOVS^BGOVPOV1(VIEN,.VFIEN) ; Fix VPOV sequencing
D:'$G(NOEVT) VFEVT^BGOUTL2($$FNUM,VFIEN,1)
S RET=VFIEN
Q
; Returns POV for current visit context
TIUSTR() N X,Y
S X=$$GETVAR^CIANBUTL("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
I X="" Q " "
S X=$$VSTR2VIS^BEHOENCX(DFN,X)
I X<1 Q " "
D GET(.X,X_"^^1")
S Y=$G(@X@(1))
K @X
Q $S(Y<0:"",1:Y)
; Returns POV for current visit context in multi-line format
TIUML(RET) ;EP
N X,I,CNT
S X=$$GETVAR^CIANBUTL("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
I X="" Q " "
S X=$$VSTR2VIS^BEHOENCX(DFN,X)
I X<1 Q " "
D GET(.X,X_"^^2")
K @RET
S (I,CNT)=0
F S I=$O(@X@(I)) Q:'I D
.S CNT=CNT+1
.S @RET@(CNT,0)=@X@(I)
S:'CNT @RET@(1,0)="No Diagnosis."
K @X
Q "~@"_$NA(@RET)
; Get VPOVs associated with a visit
; INP=Visit IEN ^ VPOV IEN (optional) ^ Format (0-detailed,1-tiu string,2-multi-line)
; Removed ICD name for Patch 12. This data is view only now
;Return array
;IEN [1] ^ Visit date [2] ^ Facility [3] ^ Facility Name [4] ^ ICD code [5] ^ Episodicity [6]
;^ Provider Narrative [7] ^ Mod [8] ^ Onset [9]
;^ Stage [10] ^Revisit [11] ^ Cause [12]^ Injury date [13] ^ External cause [14]
;^ Place of injury [15] ^Primary [16] ^Provider [17] ^ Visit IEN [18]
;^ Locked [19] ^ Asthma Cont [20] ^ SNOMED CT [21] ^ Provider Text [22] ^ qualifiers [23]
;^ Problem [24] ^ Ecode [25] ^ ICD Name [26] ^ ICD IEN [27] ^ Norm/Abn [28] ^ Laterality [29]
GET(RET,INP) ;EP
N CNT,REC,VIEN,VPOVIEN,FORMAT,IEN,PRV,PNAR,POV,ICD,ICDNAME,VDATE,DFN,CT,CT2,DESC
N STAGE,MOD,CAUSE,REVISIT,PRIM,ONSET,IDT,IPL,ICAU,FNUM,OFF,ASTHMA,CONTROL,LINE,LST,LAT,LATEXT
N SMDATA,SMCNCPCT,SMCNCP,SNOMEDCT,SNOMEDTX,PROVTEXT,QUAL,PROB,EPIS,ICCODE,ICCIEN,ICDDATA,NORM,FRAC,FRACTXT
;MSC/MGH - 07/08/09 - Offset created to support VistA and RPMS
S OFF=$S($G(DUZ("AG"))="I":0,1:9999999)
S LATEXT=""
S RET=$$TMPGBL^BGOUTL
S FNUM=$$FNUM
S VIEN=+INP
S VPOVIEN=$P(INP,U,2)
S FORMAT=+$P(INP,U,3)
S (CNT,IEN)=0
F S IEN=$O(^AUPNVPOV("AD",VIEN,IEN)) Q:'IEN D
.I VPOVIEN,VPOVIEN'=IEN Q
.S REC=$G(^AUPNVPOV(IEN,0))
.Q:REC=""
.S PRV=$P($G(^AUPNVPOV(IEN,12)),U,4)
.S:PRV PRV=$P($G(^VA(200,PRV,0)),U)
.S PNAR=$$GET1^DIQ(9000010.07,IEN,.04)
.Q:PNAR=""
.;S PNAR=$P(REC,U,4)
.S VDATE=$$FMTDATE^BGOUTL($P($G(^AUPNVSIT(VIEN,0)),U))
.I FORMAT=1 D
..S:$L(PNAR) CNT=CNT+1,@RET@(1)=$S(CNT=1:"",1:@RET@(1)_"; ")_PNAR
.E I FORMAT=2 D
..S:$L(PNAR) CNT=CNT+1,@RET@(CNT)=CNT_") "_PNAR_":"
.E D
..S POV=+REC
..;IHS/MSC/MGH Patch 12 changes
..S ICDDATA=$$ICDDX^ICDEX(POV,VDATE,"","I")
..S ICD=$P(ICDDATA,U,2),ICDNAME=$P(ICDDATA,U,4)
..Q:ICD=""
..S F=$P($G(^AUPNVSIT(VIEN,0)),U,6),DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5)
..I F S FAC=$P($G(^AUTTLOC(F,0)),U,10),FACNAM=$P($G(^(0)),U)
..E S (FAC,FACNAM)=""
..S:FACNAM FACNAM=$P($G(^DIC(4,FACNAM,0)),U)
..S STAGE=$P(REC,U,5)
..S MOD=$$EXTERNAL^DILFD(FNUM,.06,,$P(REC,U,6))
..S CAUSE=$$EXTERNAL^DILFD(FNUM,.07,,$P(REC,U,7))
..S REVISIT=$$EXTERNAL^DILFD(FNUM,.08,,$P(REC,U,8))
..S PRIM=$P(REC,U,12)
..S PRIM=$$EXTERNAL^DILFD(FNUM,.12,,$S($L(PRIM):PRIM,1:"S"))
..I DUZ("AG")="I" S ONSET=$$FMTDATE^BGOUTL($P(REC,U,17))
..E S ONSET=$$FMTDATE^BGOUTL($P($G(^AUPNVPOV(IEN,9999999)),U,17))
..S IDT=$$FMTDATE^BGOUTL($P(REC,U,13))
..S IPL=$P(REC,U,11)
..S IPL=$$EXTERNAL^DILFD(FNUM,.11,,IPL)_"~"_IPL
..S ICCIEN=$P(REC,U,9)
..S (ICCODE,ICAU)=""
..;IHS/MSC/MGH Patch 12
..S:ICCIEN ICAU=$P($$ICDDX^ICDEX(ICCIEN,VDATE,"","I"),U,4),ICCODE=$P($$ICDDX^ICDEX(ICCIEN,VDATE,"","I"),U,2)
..;CHECK FOR ASTHMA DX PATCH 10 check for entry only on this visit
..S CONTROL=""
..;MSC/DKA Patch 13 - Add SNOMED CT and Provider Text
..S SMDATA=$G(^AUPNVPOV(IEN,11)),SMCNCPCT=$P(SMDATA,U,1)
..S SMCNCP=$$CONC^BSTSAPI(SMCNCPCT_"^^^1")
..S SNOMEDCT=$P(SMCNCP,U,3),SNOMEDTX=$P(SMCNCP,U,4)
..;S PROVTEXT=$P($P(SNOMEDCT,U,4),"|",2)
..S PROVTEXT=$P(PNAR,"|",2)
..;IHS/MSC/MGH Add in SNOMED code for asthma check
..I DUZ("AG")="I" D
...S ASTHMA=$$CHECK^BGOASLK(ICD,SNOMEDCT)
...I ASTHMA=1 D
....S LEVEL=$$ACONTROL^BGOASLK(DFN,VIEN)
....;Patch 20 return both IEN and control
....S CONTROL=$P(LEVEL,U,2)_";"_$P(LEVEL,U)
....I LEVEL="" S CONTROL=";NONE RECORDED"
..S QUAL=$$GETQUAL^BGOVPOV1(IEN)
..S EPIS=$P(QUAL,U,2),QUAL=$P(QUAL,U,1)
..S PROB=$P(REC,U,16)
..S NORM=$$GET1^DIQ(9000010.07,IEN,.29,"I") ;P18
..I NORM'="" D
...D GETLST^XPAR(.LST,"ALL","BGO NORMAL/ABNORMAL")
...F I=1:1:LST D
....S ITEM=$P(LST(I),";",3)
....I ITEM=NORM S NORM=NORM_";"_$P($P(LST(I),U,2),";",1)
..;IHS/MSC/MGH return laterality
..S LAT=$$GET1^DIQ(9000010.07,IEN,1104) ;p20
..I LAT'="" D
...S LATEXT=$$CVPARM^BSTSMAP1("LAT",$P(LAT,"|",2))
..;IHS/MSC/MGH return fracture data
..S FRAC=$$GET1^DIQ(9000010.07,IEN,1106,"I") ;p23
..S FRACTXT=$$CVPARM^BSTSMAP1("HEAL",FRAC)
..;S CNT=CNT+1,@RET@(CNT)=IEN_U_VDATE_U_FAC_U_FACNAM_U_ICD_U_U_PNAR_U_MOD_U_ONSET_U_STAGE_U_REVISIT_U_CAUSE_U_IDT_U_ICAU_U_IPL_U_PRIM_U_PRV_U_VIEN_U_$$ISLOCKED^BEHOENCX(VIEN)_U_CONTROL
..S LINE=IEN_U_VDATE_U_FAC_U_FACNAM_U_ICD_U_EPIS_U_PNAR_U_MOD_U_ONSET_U_STAGE_U_REVISIT_U_CAUSE_U_IDT_U_ICAU
..S LINE=LINE_U_IPL_U_PRIM_U_PRV_U_VIEN_U_$$ISLOCKED^BEHOENCX(VIEN)_U_CONTROL_U_SNOMEDTX_U_PROVTEXT_U_QUAL_U_PROB_U_ICCODE_U_ICDNAME_U_POV_U_NORM_U_LATEXT_U_FRACTXT_"|"_FRAC
..S CNT=CNT+1,@RET@(CNT)=LINE
Q
; Delete a VPOV entry
DEL(RET,VPOV,PROB) ;EP
N IEN,VIEN,FDA,OKAY,ERR
I $G(PROB) D
.S VIEN=$P($G(^AUPNVPOV(VPOV,0)),U,3)
.Q:'+VIEN
.S IEN="" S IEN=$O(^AUPNPROB(PROB,14,"B",VIEN,IEN)) Q:'+IEN D
..S FDA(9000011.14,IEN_","_PROB_",",.01)="@"
..D UPDATE^DIE("","FDA","OKAY","ERR")
D VFDEL^BGOUTL2(.RET,$$FNUM,VPOV)
Q
; Checks validity of ICD code
; ICDIEN = ICD IEN
; ACTDT = Active Date
; Returns null if valid or -n^error text if not
CHKICD(ICDIEN,ACTDT) ;EP
N RET,X
S RET=""
S ACTDT=$G(ACTDT,DT)
;IHS/MSC/MGH Patch 12
S X=$$ICDDX^ICDEX(ICDIEN,ACTDT,"","I")
I X<0 S RET=$$ERR^BGOUTL(1092)
E I '$P(X,U,10) S RET=$$ERR^BGOUTL(1093)
I RET'="" Q RET
I $P(X,U,11)'="",$P(X,U,11)'=$P(^DPT(DFN,0),U,2) S RET=$$ERR^BGOUTL(1095)
E S RET=""
Q RET
;
CHRTREVW(RET,VIEN) ;EP
N VCODE,SNO,X,DESC,TXT,IMP,VDTE,FAC,PICD
S RET=0
S VDTE=$P($G(^AUPNVSIT(VIEN,0)),U,1)
S VCODE=$$GET^XPAR("ALL","BGO POV DEFAULT CHART",1,"E") ;P6
S FAC=$$GET1^DIQ(9000010,VIEN,.06,"I")
;P14 Changes added for ICD-10 conversion
I $$AICD^BGOUTL2 D
.S IMP=$$IMP^ICDEX("10D",DT)
.I IMP<VDTE&(VCODE["V") S VCODE="Z02.9"
.;I VCODE="" D
.;.I IMP<VDTE S VCODE="Z02.9"
.;.E S VCODE="V68.9"
E I VCODE="" S VCODE="V68.9"
S SNO=107728002
S X=$$CONC^BSTSAPI(SNO_"^^^1")
Q:X=""
S DESC=$P(X,U,3)
S PICD=$P(X,U,5)
S TXT="CHART REVIEW"
D TELECHRT(.RET,VIEN,"C",VCODE,TXT,SNO,DESC,FAC,PICD)
Q
;
TELEPHON(RET,VIEN) ;EP
N VCODE,SNO,X,DESC,TXT,VDTE,PICD
S RET=0
S VDTE=$P($G(^AUPNVSIT(VIEN,0)),U,1)
S VCODE=$$GET^XPAR("ALL","BGO POV DEFAULT TELEPHONE",1,"E") ;P6
S FAC=$$GET1^DIQ(9000010,VIEN,.06,"I")
;Changes added for ICD-10 conversion
I $$AICD^BGOUTL2 D
.S IMP=$$IMP^ICDEX("10D",DT)
.I IMP<VDTE&(VCODE["V") S VCODE="Z71.9"
E I VCODE="" S VCODE="V65.9"
S SNO=185317003
S X=$$CONC^BSTSAPI(SNO_"^^^1")
Q:X=""
S DESC=$P(X,U,3)
S PICD=$P(X,U,5)
S TXT="TELEPHONE CALL"
D TELECHRT(.RET,VIEN,"T",VCODE,TXT,SNO,DESC,FAC,PICD)
Q
TELECHRT(RET,VIEN,VCAT,VCODE,TXT,SNO,DESC,FAC,PICD) ;
N DFN,X,DEL,SPROB,PROB,SPEC,PROBSTAT
Q:$$ISLOCKED^BEHOENCX(VIEN)
S SPEC=1
S X=$G(^AUPNVSIT(+VIEN,0))
S DFN=$P(X,U,5)
Q:'DFN
Q:$P(X,U,7)'=VCAT
I '$D(^AUPNVPOV("AD",VIEN)) D
.;Next, see if this already exists as a problem on the patients list
.S MATCH=0,SPROB=""
.S PROB="" F S PROB=$O(^AUPNPROB("APCT",DFN,SNO,PROB)) Q:PROB=""!(MATCH=1) D
..S DEL=$$GET1^DIQ(9000011,PROB,2.02)
..I DEL="" S MATCH=1,SPROB=PROB
.S PROBSTAT=$$GET1^DIQ(9000011,SPROB,.12,"I")
.I PROBSTAT'="R" D UPSTAT^BGOPROB2(SPROB,"R") ;P20
.I 'SPROB S SPROB=$$ADDPROB^BGOCPTP3(DFN,SNO,DESC,VCODE,FAC,SPEC,"Routine/Admin")
.D SET(.RET,U_VIEN_U_SPROB_U_DFN_U_TXT_U_DESC_U_SNO_U_VCODE,"","","",SPEC)
Q
; Add/Edit VPOV data
; INP = VPOV IEN [1] ^ Visit IEN [2] ^ Problem IEN [3] ^ Patient IEN [4] ^ Prov Text [5] ^ Descriptive CT [6] ^
; SNOMED CT [7] ^ ICD code [8] ^ Primary/Secondary [9] ^ Provider IEN [10]^ asthma control [11] ^ norm/abn [12] ^ laterality [13] ^ fracture [14]
; QUAL = Q[1] ^ TYPE [2] ^IEN (If edit) [3] ^ SNOMED [4] ^ BY [5] ^ WHEN [6] ^DEL [7]
; INJ = Cause DX[1] ^ Injury Code [2] ^ Injury Place [3] ^ First/Revisit [4] ^ Injury Dt [5] ^ Onset Date [6]
; NORM = normal/abnormal codes
; SPEC = Special cases
SET(RET,INP,QUAL,INJ,NORM,SPEC) ;EP
N VIEN,FNUM,OFF,VFIEN,PRIEN,RET2,ADD,ADDICD,ADDIEN,DFN,DUP,FIVE,FRAC
S RET="",FNUM=$$FNUM,RET2="",DUP="",FIVE=""
S SPEC=$G(SPEC)
S INJ=$G(INJ)
S QUAL=$G(QUAL)
S NORM=$G(NORM)
S VIEN=$P(INP,U,2)
;MSC/MGH - 07/08/09 - Offset to support VistA and RPMS
S OFF=$S($G(DUZ("AG"))="I":0,1:9999999)
S VFIEN=+INP
S PRIEN=$P(INP,U,3)
S DFN=$P(INP,U,4)
;Check to see if it was missed
N X,Y,MATCH
S MATCH=0
;IHS/MSC/MGH changed for edits now since ICD can change
;I +VFIEN S SPEC=1
I 'VFIEN D
.Q:PRIEN=""
.S X="" F S X=$O(^AUPNVPOV("AD",VIEN,X)) Q:X=""!(MATCH=1) D
..S Y=$P($G(^AUPNVPOV(X,0)),U,16)
..I Y=PRIEN S VFIEN=X,MATCH=1
D SET2^BGOVPOV2(.RET,INP,QUAL,INJ,VFIEN,.DUP,.FIVE,SPEC,NORM) ;Set the main ICD as POV
;Check for additional ICDs
D ADDICD^BGOVPOV2(.RET,INP,QUAL,INJ,VFIEN,.DUP,.FIVE,SPEC)
;Add updated/reviewed data
D UPREV^BGOVPOV1(.RET2,DFN,VIEN)
Q
; Check validity of an ICD9 code
; INP = ICD IEN ^ Patient IEN ^ Visit Date ^ SNOMED ^ Laterality
; .RET = Returned as -1^Reason if not valid or null if valid
CHECK(RET,INP) ;EP
;Patch 11 changed input to fileman date
N DFN,ICDIEN,VDT,X,ANSWER,PVIEN,ITEM,ITEM2,SNO,LAT,ITEM3
S ANSWER=""
S RET=""
S ICDIEN=+INP
Q:'ICDIEN
S DFN=$P(INP,U,2)
S VDT=$P(INP,U,3)
S SNO=$P(INP,U,4)
S LAT=$P(INP,U,5)
I VDT["/" D DT^DILF("T",VDT,.ANSWER)
I ANSWER'=-1 S VDT=ANSWER
S RET=$$CHKICD(ICDIEN,VDT)
I RET="" D
.S PVIEN="" F S PVIEN=$O(^AUPNVPOV("AD",VIEN,PVIEN)) Q:PVIEN="" D
..S ITEM=$P($G(^AUPNVPOV(PVIEN,0)),U,1)
..;I ITEM=ICDIEN S RET="-1^ICD already used in this visit"
..S ITEM2=$P($G(^AUPNVPOV(PVIEN,11)),U,1)
..S ITEM3=$P($G(^AUPNVPOV(PVIEN,11)),U,4)
..I SNO]"",ITEM2=SNO,ITEM=ICDIEN,ITEM3=LAT S RET="-99^SNOMED/Laterality code already used in this visit"
Q
; Return recent POV's by patient or by visit
; INP = Patient IEN ^ Max Records ^ Visit IEN
; RET returned as a list of records in the format:
; Visit Date [1] ^ Facility ID [2] ^ Facility Name [3] ^ ICD Code [4] ^ ICD Text [5] ^
; Provider Narrative [6] ^ V POV IEN [7] ^ Visit IEN [8] ^ ICD IEN [9] ^ Visit Locked [10] ^
; Onset Date [11] ^ Asthma Control [12] ^ SNOMED CT [13]
RECENT(RET,INP) ;EP
N DFN,CNT,VIEN,MAX,VPOV,VDT
S RET=$$TMPGBL^BGOUTL
S DFN=$P(INP,U)
S MAX=$P(INP,U,2)
S:'MAX MAX=9999
S VIEN=$P(INP,U,3)
S CNT=0
D RECBYVIS:VIEN,RECBYPAT:'VIEN
Q
; VPOV's by patient
RECBYPAT S VDT=0
F S VDT=$O(^AUPNVPOV("AA",DFN,VDT)) Q:'VDT D Q:CNT'<MAX
.S VPOV=0
.F S VPOV=$O(^AUPNVPOV("AA",DFN,VDT,VPOV)) Q:'VPOV D RECBUILD Q:CNT'<MAX
Q
; VPOV's by visit
RECBYVIS S VPOV=0
F S VPOV=$O(^AUPNVPOV("AD",VIEN,VPOV)) Q:'VPOV D RECBUILD
Q
RECBUILD N REC,POV,ICD,ICDNAME,VIEN,F,FAC,FACNAM,VSIT,VDATE,PNAR,ONSET,CONTROL,SNOMED,DESCT,FRAC,FRACTXT
S REC=$G(^AUPNVPOV(VPOV,0))
S POV=+REC
Q:'POV
S VIEN=$P(REC,U,3)
Q:'VIEN
S VSIT=$G(^AUPNVSIT(VIEN,0))
S F=$P(VSIT,U,6)
I F S FAC=$P($G(^AUTTLOC(F,0)),U,10),FACNAM=$P($G(^(0)),U)
E S (FAC,FACNAM)=""
S:FACNAM FACNAM=$P($G(^DIC(4,FACNAM,0)),U)
S VDATE=$$FMTDATE^BGOUTL(+VSIT)
;Patch 12
S ICD=$P($$ICDDX^ICDEX(POV,VDATE,"","I"),U,2)
S ICDNAME=$P($$ICDDX^ICDEX(POV,VDATE,"","I"),U,4)
Q:ICDNAME=""
;end patch 12 changes
S PNAR=$$GET1^DIQ(9000010.07,VPOV,.04)
Q:PNAR=""
S SNOMED=$$GET1^DIQ(9000010.07,VPOV,1101)
S DESCT=$$GET1^DIQ(9000010.07,VPOV,1102)
S ONSET=$$FMTDATE^BGOUTL($P(REC,U,17))
;CHECK FOR ASTHMA DX PATCH 10 check for entry only on this visit
S CONTROL=""
I DUZ("AG")="I" D
.S ASTHMA=$$CHECK^BGOASLK(ICD,DESCT)
.I ASTHMA=1 S CONTROL=$P($$ACONTROL^BGOASLK(DFN,VIEN),U) I CONTROL="" S CONTROL="NONE RECORDED"
;Patch 23
S FRAC=$$GET1^DIQ(9000010.07,VPOV,1106,"I")
S FRACTXT=$$CVPARM^BSTSMAP1("HEAL",FRAC)
S CNT=CNT+1
S @RET@(CNT)=VDATE_U_FAC_U_FACNAM_U_ICD_U_ICDNAME_U_PNAR_U_VPOV_U_VIEN_U_POV_U_$$ISLOCKED^BEHOENCX(VIEN)_U_ONSET_U_CONTROL_U_SNOMED_U_FRACTXT
Q
; Return V File #
FNUM() Q 9000010.07
BGOVPOV ; IHS/BAO/TMD - Visit POV maintenance ;09-Nov-2017 14:39;PLS
+1 ;;1.1;BGO COMPONENTS;**1,3,4,5,6,7,10,11,12,13,14,19,20,23**;Mar 20, 2007;Build 1
+2 ; Check for note signed by provider
+3 ; Patch 6 added check for asthma DX
+4 ; Patch 7 added bulletin for first time diagnosis
+5 ; Patch 13 added changes to store SNOMED into POV
+6 ; Patch 14 added changes for ICD-10 implementation
+7 ; Patch 20 added laterality data
+8 ; Patch 23 added fracture data
CKSIGNBY(RET,VIEN) ;EP
+1 NEW X
+2 SET VIEN=+VIEN
+3 IF 'VIEN
QUIT
+4 SET RET=$$PRIPRV^BGOUTL(VIEN)
+5 IF RET<0
QUIT
+6 SET RET=+RET
+7 IF RET'=DUZ
SET RET=$$ERR^BGOUTL(1089)
QUIT
+8 SET RET=""
SET X=0
+9 FOR
SET X=$ORDER(^TIU(8925,"V",VIEN,X))
IF 'X
QUIT
Begin DoDot:1
+10 IF $PIECE($GET(^TIU(8925,X,15)),U,2)=DUZ
SET RET=X
End DoDot:1
IF RET
QUIT
+11 IF 'RET
SET RET=$$ERR^BGOUTL(1090)
+12 QUIT
+13 ; Lookup ICD code
+14 ; INP = ICD code ^ Reference Date
+15 ; RET = Null if not found or ICD IEN^ICD Text
GETICD(RET,INP) ;EP
+1 NEW IEN,ICD,CDT
+2 SET RET=""
SET ICD=$PIECE(INP,U)
SET CDT=$PIECE(INP,U,2)
+3 ;IHS/MSC/MSC Patch 12 changes
+4 SET IEN=$PIECE($$ICDDX^ICDEX(ICD,CDT,"","E"),U,2)
+5 IF IEN>0
SET RET=+IEN_U_$PIECE(IEN,U,4)
+6 QUIT
+7 ; Return ICD code given ICD IEN
+8 ; INP = ICD IEN ^ Reference Date
+9 ; RET = Null if not found or ICD Code^ICD Text
GETCODE(RET,INP) ;EP
+1 NEW ICDIEN,CDT
+2 SET ICDIEN=$PIECE(INP,U)
SET CDT=$PIECE(INP,U,2)
+3 ;Patch 12 changes
+4 SET RET=$$ICDDX^ICDEX(ICDIEN,CDT,"","I")
+5 SET RET=$SELECT(RET<0:"",1:$PIECE(RET,U,2)_U_$PIECE(RET,U,4))
+6 IF '$TEST
SET RET=""
+7 QUIT
+8 ; Set primary/secondary for a POV
+9 ; INP = VPOV IEN ^ Primary/Secondary (P/S)
+10 ; For patch 13 changes made to store or unstore the primary DX SNOMED code
SETPRI(RET,INP,NOEVT) ;EP
+1 NEW PRI,VFIEN,VIEN,FDA,X
+2 SET VFIEN=+INP
+3 IF 'VFIEN
SET RET=$$ERR^BGOUTL(1008)
QUIT
+4 SET PRI=$PIECE(INP,U,2)
+5 IF '$DATA(^AUPNVPOV(VFIEN,0))
SET RET=$$ERR^BGOUTL(1091)
QUIT
+6 SET VIEN=$PIECE(^AUPNVPOV(VFIEN,0),U,3)
+7 SET FDA($$FNUM,VFIEN_",",.12)=PRI
+8 IF PRI="P"
Begin DoDot:1
+9 ;Set required code
SET FDA($$FNUM,VFIEN_",",1103)=63161005
+10 SET X=0
+11 FOR
SET X=$ORDER(^AUPNVPOV("AD",VIEN,X))
IF 'X
QUIT
IF X'=VFIEN
Begin DoDot:2
+12 IF $PIECE($GET(^AUPNVPOV(X,0)),U,12)="P"
Begin DoDot:3
+13 SET FDA($$FNUM,X_",",.12)="S"
+14 SET FDA($$FNUM,X_",",1103)="@"
End DoDot:3
End DoDot:2
End DoDot:1
+15 IF '$TEST
Begin DoDot:1
+16 SET FDA($$FNUM,VFIEN_",",1103)="@"
End DoDot:1
+17 SET RET=$$UPDATE^BGOUTL(.FDA)
+18 IF RET
QUIT
+19 ;I $$FIXVPOVS^BGOVPOV1(VIEN,.VFIEN) ; Fix VPOV sequencing
+20 IF '$GET(NOEVT)
DO VFEVT^BGOUTL2($$FNUM,VFIEN,1)
+21 SET RET=VFIEN
+22 QUIT
+23 ; Returns POV for current visit context
TIUSTR() NEW X,Y
+1 SET X=$$GETVAR^CIANBUTL("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
+2 IF X=""
QUIT " "
+3 SET X=$$VSTR2VIS^BEHOENCX(DFN,X)
+4 IF X<1
QUIT " "
+5 DO GET(.X,X_"^^1")
+6 SET Y=$GET(@X@(1))
+7 KILL @X
+8 QUIT $SELECT(Y<0:"",1:Y)
+9 ; Returns POV for current visit context in multi-line format
TIUML(RET) ;EP
+1 NEW X,I,CNT
+2 SET X=$$GETVAR^CIANBUTL("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
+3 IF X=""
QUIT " "
+4 SET X=$$VSTR2VIS^BEHOENCX(DFN,X)
+5 IF X<1
QUIT " "
+6 DO GET(.X,X_"^^2")
+7 KILL @RET
+8 SET (I,CNT)=0
+9 FOR
SET I=$ORDER(@X@(I))
IF 'I
QUIT
Begin DoDot:1
+10 SET CNT=CNT+1
+11 SET @RET@(CNT,0)=@X@(I)
End DoDot:1
+12 IF 'CNT
SET @RET@(1,0)="No Diagnosis."
+13 KILL @X
+14 QUIT "~@"_$NAME(@RET)
+15 ; Get VPOVs associated with a visit
+16 ; INP=Visit IEN ^ VPOV IEN (optional) ^ Format (0-detailed,1-tiu string,2-multi-line)
+17 ; Removed ICD name for Patch 12. This data is view only now
+18 ;Return array
+19 ;IEN [1] ^ Visit date [2] ^ Facility [3] ^ Facility Name [4] ^ ICD code [5] ^ Episodicity [6]
+20 ;^ Provider Narrative [7] ^ Mod [8] ^ Onset [9]
+21 ;^ Stage [10] ^Revisit [11] ^ Cause [12]^ Injury date [13] ^ External cause [14]
+22 ;^ Place of injury [15] ^Primary [16] ^Provider [17] ^ Visit IEN [18]
+23 ;^ Locked [19] ^ Asthma Cont [20] ^ SNOMED CT [21] ^ Provider Text [22] ^ qualifiers [23]
+24 ;^ Problem [24] ^ Ecode [25] ^ ICD Name [26] ^ ICD IEN [27] ^ Norm/Abn [28] ^ Laterality [29]
GET(RET,INP) ;EP
+1 NEW CNT,REC,VIEN,VPOVIEN,FORMAT,IEN,PRV,PNAR,POV,ICD,ICDNAME,VDATE,DFN,CT,CT2,DESC
+2 NEW STAGE,MOD,CAUSE,REVISIT,PRIM,ONSET,IDT,IPL,ICAU,FNUM,OFF,ASTHMA,CONTROL,LINE,LST,LAT,LATEXT
+3 NEW SMDATA,SMCNCPCT,SMCNCP,SNOMEDCT,SNOMEDTX,PROVTEXT,QUAL,PROB,EPIS,ICCODE,ICCIEN,ICDDATA,NORM,FRAC,FRACTXT
+4 ;MSC/MGH - 07/08/09 - Offset created to support VistA and RPMS
+5 SET OFF=$SELECT($GET(DUZ("AG"))="I":0,1:9999999)
+6 SET LATEXT=""
+7 SET RET=$$TMPGBL^BGOUTL
+8 SET FNUM=$$FNUM
+9 SET VIEN=+INP
+10 SET VPOVIEN=$PIECE(INP,U,2)
+11 SET FORMAT=+$PIECE(INP,U,3)
+12 SET (CNT,IEN)=0
+13 FOR
SET IEN=$ORDER(^AUPNVPOV("AD",VIEN,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+14 IF VPOVIEN
IF VPOVIEN'=IEN
QUIT
+15 SET REC=$GET(^AUPNVPOV(IEN,0))
+16 IF REC=""
QUIT
+17 SET PRV=$PIECE($GET(^AUPNVPOV(IEN,12)),U,4)
+18 IF PRV
SET PRV=$PIECE($GET(^VA(200,PRV,0)),U)
+19 SET PNAR=$$GET1^DIQ(9000010.07,IEN,.04)
+20 IF PNAR=""
QUIT
+21 ;S PNAR=$P(REC,U,4)
+22 SET VDATE=$$FMTDATE^BGOUTL($PIECE($GET(^AUPNVSIT(VIEN,0)),U))
+23 IF FORMAT=1
Begin DoDot:2
+24 IF $LENGTH(PNAR)
SET CNT=CNT+1
SET @RET@(1)=$SELECT(CNT=1:"",1:@RET@(1)_"; ")_PNAR
End DoDot:2
+25 IF '$TEST
IF FORMAT=2
Begin DoDot:2
+26 IF $LENGTH(PNAR)
SET CNT=CNT+1
SET @RET@(CNT)=CNT_") "_PNAR_":"
End DoDot:2
+27 IF '$TEST
Begin DoDot:2
+28 SET POV=+REC
+29 ;IHS/MSC/MGH Patch 12 changes
+30 SET ICDDATA=$$ICDDX^ICDEX(POV,VDATE,"","I")
+31 SET ICD=$PIECE(ICDDATA,U,2)
SET ICDNAME=$PIECE(ICDDATA,U,4)
+32 IF ICD=""
QUIT
+33 SET F=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,6)
SET DFN=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,5)
+34 IF F
SET FAC=$PIECE($GET(^AUTTLOC(F,0)),U,10)
SET FACNAM=$PIECE($GET(^(0)),U)
+35 IF '$TEST
SET (FAC,FACNAM)=""
+36 IF FACNAM
SET FACNAM=$PIECE($GET(^DIC(4,FACNAM,0)),U)
+37 SET STAGE=$PIECE(REC,U,5)
+38 SET MOD=$$EXTERNAL^DILFD(FNUM,.06,,$PIECE(REC,U,6))
+39 SET CAUSE=$$EXTERNAL^DILFD(FNUM,.07,,$PIECE(REC,U,7))
+40 SET REVISIT=$$EXTERNAL^DILFD(FNUM,.08,,$PIECE(REC,U,8))
+41 SET PRIM=$PIECE(REC,U,12)
+42 SET PRIM=$$EXTERNAL^DILFD(FNUM,.12,,$SELECT($LENGTH(PRIM):PRIM,1:"S"))
+43 IF DUZ("AG")="I"
SET ONSET=$$FMTDATE^BGOUTL($PIECE(REC,U,17))
+44 IF '$TEST
SET ONSET=$$FMTDATE^BGOUTL($PIECE($GET(^AUPNVPOV(IEN,9999999)),U,17))
+45 SET IDT=$$FMTDATE^BGOUTL($PIECE(REC,U,13))
+46 SET IPL=$PIECE(REC,U,11)
+47 SET IPL=$$EXTERNAL^DILFD(FNUM,.11,,IPL)_"~"_IPL
+48 SET ICCIEN=$PIECE(REC,U,9)
+49 SET (ICCODE,ICAU)=""
+50 ;IHS/MSC/MGH Patch 12
+51 IF ICCIEN
SET ICAU=$PIECE($$ICDDX^ICDEX(ICCIEN,VDATE,"","I"),U,4)
SET ICCODE=$PIECE($$ICDDX^ICDEX(ICCIEN,VDATE,"","I"),U,2)
+52 ;CHECK FOR ASTHMA DX PATCH 10 check for entry only on this visit
+53 SET CONTROL=""
+54 ;MSC/DKA Patch 13 - Add SNOMED CT and Provider Text
+55 SET SMDATA=$GET(^AUPNVPOV(IEN,11))
SET SMCNCPCT=$PIECE(SMDATA,U,1)
+56 SET SMCNCP=$$CONC^BSTSAPI(SMCNCPCT_"^^^1")
+57 SET SNOMEDCT=$PIECE(SMCNCP,U,3)
SET SNOMEDTX=$PIECE(SMCNCP,U,4)
+58 ;S PROVTEXT=$P($P(SNOMEDCT,U,4),"|",2)
+59 SET PROVTEXT=$PIECE(PNAR,"|",2)
+60 ;IHS/MSC/MGH Add in SNOMED code for asthma check
+61 IF DUZ("AG")="I"
Begin DoDot:3
+62 SET ASTHMA=$$CHECK^BGOASLK(ICD,SNOMEDCT)
+63 IF ASTHMA=1
Begin DoDot:4
+64 SET LEVEL=$$ACONTROL^BGOASLK(DFN,VIEN)
+65 ;Patch 20 return both IEN and control
+66 SET CONTROL=$PIECE(LEVEL,U,2)_";"_$PIECE(LEVEL,U)
+67 IF LEVEL=""
SET CONTROL=";NONE RECORDED"
End DoDot:4
End DoDot:3
+68 SET QUAL=$$GETQUAL^BGOVPOV1(IEN)
+69 SET EPIS=$PIECE(QUAL,U,2)
SET QUAL=$PIECE(QUAL,U,1)
+70 SET PROB=$PIECE(REC,U,16)
+71 ;P18
SET NORM=$$GET1^DIQ(9000010.07,IEN,.29,"I")
+72 IF NORM'=""
Begin DoDot:3
+73 DO GETLST^XPAR(.LST,"ALL","BGO NORMAL/ABNORMAL")
+74 FOR I=1:1:LST
Begin DoDot:4
+75 SET ITEM=$PIECE(LST(I),";",3)
+76 IF ITEM=NORM
SET NORM=NORM_";"_$PIECE($PIECE(LST(I),U,2),";",1)
End DoDot:4
End DoDot:3
+77 ;IHS/MSC/MGH return laterality
+78 ;p20
SET LAT=$$GET1^DIQ(9000010.07,IEN,1104)
+79 IF LAT'=""
Begin DoDot:3
+80 SET LATEXT=$$CVPARM^BSTSMAP1("LAT",$PIECE(LAT,"|",2))
End DoDot:3
+81 ;IHS/MSC/MGH return fracture data
+82 ;p23
SET FRAC=$$GET1^DIQ(9000010.07,IEN,1106,"I")
+83 SET FRACTXT=$$CVPARM^BSTSMAP1("HEAL",FRAC)
+84 ;S CNT=CNT+1,@RET@(CNT)=IEN_U_VDATE_U_FAC_U_FACNAM_U_ICD_U_U_PNAR_U_MOD_U_ONSET_U_STAGE_U_REVISIT_U_CAUSE_U_IDT_U_ICAU_U_IPL_U_PRIM_U_PRV_U_VIEN_U_$$ISLOCKED^BEHOENCX(VIEN)_U_CONTROL
+85 SET LINE=IEN_U_VDATE_U_FAC_U_FACNAM_U_ICD_U_EPIS_U_PNAR_U_MOD_U_ONSET_U_STAGE_U_REVISIT_U_CAUSE_U_IDT_U_ICAU
+86 SET LINE=LINE_U_IPL_U_PRIM_U_PRV_U_VIEN_U_$$ISLOCKED^BEHOENCX(VIEN)_U_CONTROL_U_SNOMEDTX_U_PROVTEXT_U_QUAL_U_PROB_U_ICCODE_U_ICDNAME_U_POV_U_NORM_U_LATEXT_U_FRACTXT_"|"_FRAC
+87 SET CNT=CNT+1
SET @RET@(CNT)=LINE
End DoDot:2
End DoDot:1
+88 QUIT
+89 ; Delete a VPOV entry
DEL(RET,VPOV,PROB) ;EP
+1 NEW IEN,VIEN,FDA,OKAY,ERR
+2 IF $GET(PROB)
Begin DoDot:1
+3 SET VIEN=$PIECE($GET(^AUPNVPOV(VPOV,0)),U,3)
+4 IF '+VIEN
QUIT
+5 SET IEN=""
SET IEN=$ORDER(^AUPNPROB(PROB,14,"B",VIEN,IEN))
IF '+IEN
QUIT
Begin DoDot:2
+6 SET FDA(9000011.14,IEN_","_PROB_",",.01)="@"
+7 DO UPDATE^DIE("","FDA","OKAY","ERR")
End DoDot:2
End DoDot:1
+8 DO VFDEL^BGOUTL2(.RET,$$FNUM,VPOV)
+9 QUIT
+10 ; Checks validity of ICD code
+11 ; ICDIEN = ICD IEN
+12 ; ACTDT = Active Date
+13 ; Returns null if valid or -n^error text if not
CHKICD(ICDIEN,ACTDT) ;EP
+1 NEW RET,X
+2 SET RET=""
+3 SET ACTDT=$GET(ACTDT,DT)
+4 ;IHS/MSC/MGH Patch 12
+5 SET X=$$ICDDX^ICDEX(ICDIEN,ACTDT,"","I")
+6 IF X<0
SET RET=$$ERR^BGOUTL(1092)
+7 IF '$TEST
IF '$PIECE(X,U,10)
SET RET=$$ERR^BGOUTL(1093)
+8 IF RET'=""
QUIT RET
+9 IF $PIECE(X,U,11)'=""
IF $PIECE(X,U,11)'=$PIECE(^DPT(DFN,0),U,2)
SET RET=$$ERR^BGOUTL(1095)
+10 IF '$TEST
SET RET=""
+11 QUIT RET
+12 ;
CHRTREVW(RET,VIEN) ;EP
+1 NEW VCODE,SNO,X,DESC,TXT,IMP,VDTE,FAC,PICD
+2 SET RET=0
+3 SET VDTE=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,1)
+4 ;P6
SET VCODE=$$GET^XPAR("ALL","BGO POV DEFAULT CHART",1,"E")
+5 SET FAC=$$GET1^DIQ(9000010,VIEN,.06,"I")
+6 ;P14 Changes added for ICD-10 conversion
+7 IF $$AICD^BGOUTL2
Begin DoDot:1
+8 SET IMP=$$IMP^ICDEX("10D",DT)
+9 IF IMP<VDTE&(VCODE["V")
SET VCODE="Z02.9"
+10 ;I VCODE="" D
+11 ;.I IMP<VDTE S VCODE="Z02.9"
+12 ;.E S VCODE="V68.9"
End DoDot:1
+13 IF '$TEST
IF VCODE=""
SET VCODE="V68.9"
+14 SET SNO=107728002
+15 SET X=$$CONC^BSTSAPI(SNO_"^^^1")
+16 IF X=""
QUIT
+17 SET DESC=$PIECE(X,U,3)
+18 SET PICD=$PIECE(X,U,5)
+19 SET TXT="CHART REVIEW"
+20 DO TELECHRT(.RET,VIEN,"C",VCODE,TXT,SNO,DESC,FAC,PICD)
+21 QUIT
+22 ;
TELEPHON(RET,VIEN) ;EP
+1 NEW VCODE,SNO,X,DESC,TXT,VDTE,PICD
+2 SET RET=0
+3 SET VDTE=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,1)
+4 ;P6
SET VCODE=$$GET^XPAR("ALL","BGO POV DEFAULT TELEPHONE",1,"E")
+5 SET FAC=$$GET1^DIQ(9000010,VIEN,.06,"I")
+6 ;Changes added for ICD-10 conversion
+7 IF $$AICD^BGOUTL2
Begin DoDot:1
+8 SET IMP=$$IMP^ICDEX("10D",DT)
+9 IF IMP<VDTE&(VCODE["V")
SET VCODE="Z71.9"
End DoDot:1
+10 IF '$TEST
IF VCODE=""
SET VCODE="V65.9"
+11 SET SNO=185317003
+12 SET X=$$CONC^BSTSAPI(SNO_"^^^1")
+13 IF X=""
QUIT
+14 SET DESC=$PIECE(X,U,3)
+15 SET PICD=$PIECE(X,U,5)
+16 SET TXT="TELEPHONE CALL"
+17 DO TELECHRT(.RET,VIEN,"T",VCODE,TXT,SNO,DESC,FAC,PICD)
+18 QUIT
TELECHRT(RET,VIEN,VCAT,VCODE,TXT,SNO,DESC,FAC,PICD) ;
+1 NEW DFN,X,DEL,SPROB,PROB,SPEC,PROBSTAT
+2 IF $$ISLOCKED^BEHOENCX(VIEN)
QUIT
+3 SET SPEC=1
+4 SET X=$GET(^AUPNVSIT(+VIEN,0))
+5 SET DFN=$PIECE(X,U,5)
+6 IF 'DFN
QUIT
+7 IF $PIECE(X,U,7)'=VCAT
QUIT
+8 IF '$DATA(^AUPNVPOV("AD",VIEN))
Begin DoDot:1
+9 ;Next, see if this already exists as a problem on the patients list
+10 SET MATCH=0
SET SPROB=""
+11 SET PROB=""
FOR
SET PROB=$ORDER(^AUPNPROB("APCT",DFN,SNO,PROB))
IF PROB=""!(MATCH=1)
QUIT
Begin DoDot:2
+12 SET DEL=$$GET1^DIQ(9000011,PROB,2.02)
+13 IF DEL=""
SET MATCH=1
SET SPROB=PROB
End DoDot:2
+14 SET PROBSTAT=$$GET1^DIQ(9000011,SPROB,.12,"I")
+15 ;P20
IF PROBSTAT'="R"
DO UPSTAT^BGOPROB2(SPROB,"R")
+16 IF 'SPROB
SET SPROB=$$ADDPROB^BGOCPTP3(DFN,SNO,DESC,VCODE,FAC,SPEC,"Routine/Admin")
+17 DO SET(.RET,U_VIEN_U_SPROB_U_DFN_U_TXT_U_DESC_U_SNO_U_VCODE,"","","",SPEC)
End DoDot:1
+18 QUIT
+19 ; Add/Edit VPOV data
+20 ; INP = VPOV IEN [1] ^ Visit IEN [2] ^ Problem IEN [3] ^ Patient IEN [4] ^ Prov Text [5] ^ Descriptive CT [6] ^
+21 ; SNOMED CT [7] ^ ICD code [8] ^ Primary/Secondary [9] ^ Provider IEN [10]^ asthma control [11] ^ norm/abn [12] ^ laterality [13] ^ fracture [14]
+22 ; QUAL = Q[1] ^ TYPE [2] ^IEN (If edit) [3] ^ SNOMED [4] ^ BY [5] ^ WHEN [6] ^DEL [7]
+23 ; INJ = Cause DX[1] ^ Injury Code [2] ^ Injury Place [3] ^ First/Revisit [4] ^ Injury Dt [5] ^ Onset Date [6]
+24 ; NORM = normal/abnormal codes
+25 ; SPEC = Special cases
SET(RET,INP,QUAL,INJ,NORM,SPEC) ;EP
+1 NEW VIEN,FNUM,OFF,VFIEN,PRIEN,RET2,ADD,ADDICD,ADDIEN,DFN,DUP,FIVE,FRAC
+2 SET RET=""
SET FNUM=$$FNUM
SET RET2=""
SET DUP=""
SET FIVE=""
+3 SET SPEC=$GET(SPEC)
+4 SET INJ=$GET(INJ)
+5 SET QUAL=$GET(QUAL)
+6 SET NORM=$GET(NORM)
+7 SET VIEN=$PIECE(INP,U,2)
+8 ;MSC/MGH - 07/08/09 - Offset to support VistA and RPMS
+9 SET OFF=$SELECT($GET(DUZ("AG"))="I":0,1:9999999)
+10 SET VFIEN=+INP
+11 SET PRIEN=$PIECE(INP,U,3)
+12 SET DFN=$PIECE(INP,U,4)
+13 ;Check to see if it was missed
+14 NEW X,Y,MATCH
+15 SET MATCH=0
+16 ;IHS/MSC/MGH changed for edits now since ICD can change
+17 ;I +VFIEN S SPEC=1
+18 IF 'VFIEN
Begin DoDot:1
+19 IF PRIEN=""
QUIT
+20 SET X=""
FOR
SET X=$ORDER(^AUPNVPOV("AD",VIEN,X))
IF X=""!(MATCH=1)
QUIT
Begin DoDot:2
+21 SET Y=$PIECE($GET(^AUPNVPOV(X,0)),U,16)
+22 IF Y=PRIEN
SET VFIEN=X
SET MATCH=1
End DoDot:2
End DoDot:1
+23 ;Set the main ICD as POV
DO SET2^BGOVPOV2(.RET,INP,QUAL,INJ,VFIEN,.DUP,.FIVE,SPEC,NORM)
+24 ;Check for additional ICDs
+25 DO ADDICD^BGOVPOV2(.RET,INP,QUAL,INJ,VFIEN,.DUP,.FIVE,SPEC)
+26 ;Add updated/reviewed data
+27 DO UPREV^BGOVPOV1(.RET2,DFN,VIEN)
+28 QUIT
+29 ; Check validity of an ICD9 code
+30 ; INP = ICD IEN ^ Patient IEN ^ Visit Date ^ SNOMED ^ Laterality
+31 ; .RET = Returned as -1^Reason if not valid or null if valid
CHECK(RET,INP) ;EP
+1 ;Patch 11 changed input to fileman date
+2 NEW DFN,ICDIEN,VDT,X,ANSWER,PVIEN,ITEM,ITEM2,SNO,LAT,ITEM3
+3 SET ANSWER=""
+4 SET RET=""
+5 SET ICDIEN=+INP
+6 IF 'ICDIEN
QUIT
+7 SET DFN=$PIECE(INP,U,2)
+8 SET VDT=$PIECE(INP,U,3)
+9 SET SNO=$PIECE(INP,U,4)
+10 SET LAT=$PIECE(INP,U,5)
+11 IF VDT["/"
DO DT^DILF("T",VDT,.ANSWER)
+12 IF ANSWER'=-1
SET VDT=ANSWER
+13 SET RET=$$CHKICD(ICDIEN,VDT)
+14 IF RET=""
Begin DoDot:1
+15 SET PVIEN=""
FOR
SET PVIEN=$ORDER(^AUPNVPOV("AD",VIEN,PVIEN))
IF PVIEN=""
QUIT
Begin DoDot:2
+16 SET ITEM=$PIECE($GET(^AUPNVPOV(PVIEN,0)),U,1)
+17 ;I ITEM=ICDIEN S RET="-1^ICD already used in this visit"
+18 SET ITEM2=$PIECE($GET(^AUPNVPOV(PVIEN,11)),U,1)
+19 SET ITEM3=$PIECE($GET(^AUPNVPOV(PVIEN,11)),U,4)
+20 IF SNO]""
IF ITEM2=SNO
IF ITEM=ICDIEN
IF ITEM3=LAT
SET RET="-99^SNOMED/Laterality code already used in this visit"
End DoDot:2
End DoDot:1
+21 QUIT
+22 ; Return recent POV's by patient or by visit
+23 ; INP = Patient IEN ^ Max Records ^ Visit IEN
+24 ; RET returned as a list of records in the format:
+25 ; Visit Date [1] ^ Facility ID [2] ^ Facility Name [3] ^ ICD Code [4] ^ ICD Text [5] ^
+26 ; Provider Narrative [6] ^ V POV IEN [7] ^ Visit IEN [8] ^ ICD IEN [9] ^ Visit Locked [10] ^
+27 ; Onset Date [11] ^ Asthma Control [12] ^ SNOMED CT [13]
RECENT(RET,INP) ;EP
+1 NEW DFN,CNT,VIEN,MAX,VPOV,VDT
+2 SET RET=$$TMPGBL^BGOUTL
+3 SET DFN=$PIECE(INP,U)
+4 SET MAX=$PIECE(INP,U,2)
+5 IF 'MAX
SET MAX=9999
+6 SET VIEN=$PIECE(INP,U,3)
+7 SET CNT=0
+8 IF VIEN
DO RECBYVIS
IF 'VIEN
DO RECBYPAT
+9 QUIT
+10 ; VPOV's by patient
RECBYPAT SET VDT=0
+1 FOR
SET VDT=$ORDER(^AUPNVPOV("AA",DFN,VDT))
IF 'VDT
QUIT
Begin DoDot:1
+2 SET VPOV=0
+3 FOR
SET VPOV=$ORDER(^AUPNVPOV("AA",DFN,VDT,VPOV))
IF 'VPOV
QUIT
DO RECBUILD
IF CNT'<MAX
QUIT
End DoDot:1
IF CNT'<MAX
QUIT
+4 QUIT
+5 ; VPOV's by visit
RECBYVIS SET VPOV=0
+1 FOR
SET VPOV=$ORDER(^AUPNVPOV("AD",VIEN,VPOV))
IF 'VPOV
QUIT
DO RECBUILD
+2 QUIT
RECBUILD NEW REC,POV,ICD,ICDNAME,VIEN,F,FAC,FACNAM,VSIT,VDATE,PNAR,ONSET,CONTROL,SNOMED,DESCT,FRAC,FRACTXT
+1 SET REC=$GET(^AUPNVPOV(VPOV,0))
+2 SET POV=+REC
+3 IF 'POV
QUIT
+4 SET VIEN=$PIECE(REC,U,3)
+5 IF 'VIEN
QUIT
+6 SET VSIT=$GET(^AUPNVSIT(VIEN,0))
+7 SET F=$PIECE(VSIT,U,6)
+8 IF F
SET FAC=$PIECE($GET(^AUTTLOC(F,0)),U,10)
SET FACNAM=$PIECE($GET(^(0)),U)
+9 IF '$TEST
SET (FAC,FACNAM)=""
+10 IF FACNAM
SET FACNAM=$PIECE($GET(^DIC(4,FACNAM,0)),U)
+11 SET VDATE=$$FMTDATE^BGOUTL(+VSIT)
+12 ;Patch 12
+13 SET ICD=$PIECE($$ICDDX^ICDEX(POV,VDATE,"","I"),U,2)
+14 SET ICDNAME=$PIECE($$ICDDX^ICDEX(POV,VDATE,"","I"),U,4)
+15 IF ICDNAME=""
QUIT
+16 ;end patch 12 changes
+17 SET PNAR=$$GET1^DIQ(9000010.07,VPOV,.04)
+18 IF PNAR=""
QUIT
+19 SET SNOMED=$$GET1^DIQ(9000010.07,VPOV,1101)
+20 SET DESCT=$$GET1^DIQ(9000010.07,VPOV,1102)
+21 SET ONSET=$$FMTDATE^BGOUTL($PIECE(REC,U,17))
+22 ;CHECK FOR ASTHMA DX PATCH 10 check for entry only on this visit
+23 SET CONTROL=""
+24 IF DUZ("AG")="I"
Begin DoDot:1
+25 SET ASTHMA=$$CHECK^BGOASLK(ICD,DESCT)
+26 IF ASTHMA=1
SET CONTROL=$PIECE($$ACONTROL^BGOASLK(DFN,VIEN),U)
IF CONTROL=""
SET CONTROL="NONE RECORDED"
End DoDot:1
+27 ;Patch 23
+28 SET FRAC=$$GET1^DIQ(9000010.07,VPOV,1106,"I")
+29 SET FRACTXT=$$CVPARM^BSTSMAP1("HEAL",FRAC)
+30 SET CNT=CNT+1
+31 SET @RET@(CNT)=VDATE_U_FAC_U_FACNAM_U_ICD_U_ICDNAME_U_PNAR_U_VPOV_U_VIEN_U_POV_U_$$ISLOCKED^BEHOENCX(VIEN)_U_ONSET_U_CONTROL_U_SNOMED_U_FRACTXT
+32 QUIT
+33 ; Return V File #
FNUM() QUIT 9000010.07
