BGOVPRC ; IHS/BAO/TMD - Manage V PROCEDURE ;15-Jan-2015 08:13;du
;;1.1;BGO COMPONENTS;**1,3,11,12,14**;Mar 20, 2007;Build 5
; Add/edit V Procedure entry
; INP = V File IEN [1] ^ ICD0 IEN [2] ^ Visit IEN [3] ^ Patient IEN [4] ^ Event Date [5] ^ Diagnosis [6] ^
; Principal [7] ^ Narrative [8] ^ Infection [9] ^ Operating Provider [10] ^ Anesthesiologist [11] ^
; Anesthesia Time [12] ^ Location IEN [13] ^ Outside Location [14] ^ Historical [15] ^ Allow dups [16]
SET(RET,INP) ;EP
N VIEN,VCAT,VFIEN,TYPE,DFN,EVNTDT,DX,PRIN,NARR,INFECT,OPRPRV,ANESTH,ANESTIME
N LOCIEN,OUTLOC,HIST,APCDVSIT,APCDDATE,FNEW,FDA,VFNEW,DUPS,X,Y,FNUM,PROCDT,IMP
S RET="",FNUM=$$FNUM
S VFIEN=+INP
S VFNEW='VFIEN
S TYPE=+$P(INP,U,2)
S (VIEN,APCDVSIT)=+$P(INP,U,3)
I $$AICD^BGOUTL2 D
.S (Y,APCDDATE)=+$G(^AUPNVSIT(VIEN,0))
.S X=$$ICDOP^ICDEX(TYPE,Y,"","I")
.I $P(X,U,1)=-1 S RET="-1^You may not use this ICD procedure for this visit date, please use visit services to assign this procedure" Q
.I $P(X,U,10)'=1 S RET="-1^ICD procedure code is not active. Use visit service to enter an ICD procedure" Q
.S IMP=$$IMP^ICDEX("10P",DT) ;Get the implementaton date
.I IMP>Y D ;This needs to be an ICD-9 code
..I $P(X,U,15)'=2 S RET="-1^You may not use this ICD procedure for this visit date, please use visit services to assign this procedure" Q
.I IMP<Y D
..I $P(X,U,15)'=31 S RET="-1^You may not use this ICD procedure for this visit date, please use visit services to assign this procedure" Q
E D
.S X=$G(^ICD0(TYPE,0))
.I '$L(X) S RET=$$ERR^BGOUTL(1096) Q
.I $P(X,U,9) S RET=$$ERR^BGOUTL(1097) Q
.S X=$P(X,U,11)
.S Y=+$G(^AUPNVSIT(VIEN,0))
.I X,Y,$$FMDIFF^XLFDT(Y,X)>-1 S RET=$$ERR^BGOUTL(1097) Q
Q:RET
S DFN=+$P(INP,U,4)
S EVNTDT=$$CVTDATE^BGOUTL($P(INP,U,5))
I EVNTDT="" S EVNTDT=$P($G(^AUPNVSIT(VIEN,0)),U,1)
S PROCDT=$P(EVNTDT,".",1)
S DX=$P(INP,U,6)
S PRIN=$P(INP,U,7)
S RET=$$FNDNARR^BGOUTL2($P(INP,U,8))
Q:RET<0
S NARR=$S(RET:"`"_RET,1:""),RET=""
S INFECT=$P(INP,U,9)
S OPRPRV=$P(INP,U,10)
S ANESTH=$P(INP,U,11)
S ANESTIME=$P(INP,U,12)
S LOCIEN=$P(INP,U,13)
S OUTLOC=$P(INP,U,14)
S HIST=$P(INP,U,15)
S DUPS=$P(INP,U,16)
I 'VIEN,'HIST S RET=$$ERR^BGOUTL(1002) Q
S VCAT=$P($G(^AUPNVSIT(VIEN,0)),U,7)
S:VCAT="E" HIST=1
I HIST D Q:RET<0
.S RET=$$MAKEHIST^BGOUTL(DFN,EVNTDT,$S($L(OUTLOC):OUTLOC,1:LOCIEN),VIEN)
.S:RET>0 VIEN=RET
S RET=$$CHKVISIT^BGOUTL(VIEN,DFN)
Q:RET
I 'VFIEN D Q:'VFIEN
.D VFNEW^BGOUTL2(.RET,FNUM,TYPE,VIEN,$S('DUPS:"Procedure",1:""))
.S:RET>0 VFIEN=RET,RET=""
S FDA=$NA(FDA(FNUM,VFIEN_","))
S @FDA@(.01)="`"_TYPE
S @FDA@(.04)=NARR
S @FDA@(.05)=$S(DX:"`"_DX,1:"")
S @FDA@(.06)=PROCDT
S @FDA@(.07)=PRIN
S @FDA@(.08)=INFECT
S @FDA@(.11)=$S(OPRPRV:"`"_OPRPRV,1:"")
S @FDA@(.12)=$S(ANESTH:"`"_ANESTH,1:"")
S @FDA@(.13)=ANESTIME
S @FDA@(1201)=$S(EVNTDT:EVNTDT,1:"N")
S @FDA@(1204)="`"_DUZ
;Patch 11 Set date entered
I VFNEW D
.S @FDA@(1216)="N"
.S @FDA@(1217)="`"_DUZ
;Patch 11 Set last modified
S @FDA@(1218)="N"
S @FDA@(1219)="`"_DUZ
S RET=$$UPDATE^BGOUTL(.FDA,"E")
I RET,VFNEW,$$DELETE^BGOUTL(FNUM,VFIEN)
D:'RET VFEVT^BGOUTL2(FNUM,VFIEN,'VFNEW)
S:'RET RET=VFIEN
Q
; INP = Lookup Value [1] ^ VIEN [2]
; LKP = Text to lookup
; VIEN = Visit IEN
LOOKUP(RET,INP) ;Lookup an ICD0 term with this call after AICD patch is installed
N GBL,LKP,FROM,DIR,MAX,XREF,INP2,RET2,I,CNT,VIEN,VDT,ROOT,X,Y,VER,OUT,SYS
N FLDS,IEN,IMP
S GBL=80.1
S RET=$$TMPGBL
K ^TMP("ICD0",$J)
S LKP=$P(INP,U,1)
Q:LKP="" RET
S VIEN=$P(INP,U,2)
S VDT=""
I +VIEN S VDT=$$GET1^DIQ(9000010,VIEN,.01,"I")
I VDT="" S VDT=DT
S FLDS=".01"
S CNT=0
S FROM=LKP
S DIR=1
S MAX=999,XREF="D"
S INP2="80.1"_U_LKP_U_FROM_U_DIR_U_MAX_U_XREF_"^^^"_U_VDT
D DICLKUP^BGOUTL(.RET2,INP2)
M RET=RET2
Q
; Return V File #
FNUM() Q 9000010.08
TMPGBL(X) ;EP
K ^TMP("BGOPRC",$J) Q $NA(^($J))
BGOVPRC ; IHS/BAO/TMD - Manage V PROCEDURE ;15-Jan-2015 08:13;du
+1 ;;1.1;BGO COMPONENTS;**1,3,11,12,14**;Mar 20, 2007;Build 5
+2 ; Add/edit V Procedure entry
+3 ; INP = V File IEN [1] ^ ICD0 IEN [2] ^ Visit IEN [3] ^ Patient IEN [4] ^ Event Date [5] ^ Diagnosis [6] ^
+4 ; Principal [7] ^ Narrative [8] ^ Infection [9] ^ Operating Provider [10] ^ Anesthesiologist [11] ^
+5 ; Anesthesia Time [12] ^ Location IEN [13] ^ Outside Location [14] ^ Historical [15] ^ Allow dups [16]
SET(RET,INP) ;EP
+1 NEW VIEN,VCAT,VFIEN,TYPE,DFN,EVNTDT,DX,PRIN,NARR,INFECT,OPRPRV,ANESTH,ANESTIME
+2 NEW LOCIEN,OUTLOC,HIST,APCDVSIT,APCDDATE,FNEW,FDA,VFNEW,DUPS,X,Y,FNUM,PROCDT,IMP
+3 SET RET=""
SET FNUM=$$FNUM
+4 SET VFIEN=+INP
+5 SET VFNEW='VFIEN
+6 SET TYPE=+$PIECE(INP,U,2)
+7 SET (VIEN,APCDVSIT)=+$PIECE(INP,U,3)
+8 IF $$AICD^BGOUTL2
Begin DoDot:1
+9 SET (Y,APCDDATE)=+$GET(^AUPNVSIT(VIEN,0))
+10 SET X=$$ICDOP^ICDEX(TYPE,Y,"","I")
+11 IF $PIECE(X,U,1)=-1
SET RET="-1^You may not use this ICD procedure for this visit date, please use visit services to assign this procedure"
QUIT
+12 IF $PIECE(X,U,10)'=1
SET RET="-1^ICD procedure code is not active. Use visit service to enter an ICD procedure"
QUIT
+13 ;Get the implementaton date
SET IMP=$$IMP^ICDEX("10P",DT)
+14 ;This needs to be an ICD-9 code
IF IMP>Y
Begin DoDot:2
+15 IF $PIECE(X,U,15)'=2
SET RET="-1^You may not use this ICD procedure for this visit date, please use visit services to assign this procedure"
QUIT
End DoDot:2
+16 IF IMP<Y
Begin DoDot:2
+17 IF $PIECE(X,U,15)'=31
SET RET="-1^You may not use this ICD procedure for this visit date, please use visit services to assign this procedure"
QUIT
End DoDot:2
End DoDot:1
+18 IF '$TEST
Begin DoDot:1
+19 SET X=$GET(^ICD0(TYPE,0))
+20 IF '$LENGTH(X)
SET RET=$$ERR^BGOUTL(1096)
QUIT
+21 IF $PIECE(X,U,9)
SET RET=$$ERR^BGOUTL(1097)
QUIT
+22 SET X=$PIECE(X,U,11)
+23 SET Y=+$GET(^AUPNVSIT(VIEN,0))
+24 IF X
IF Y
IF $$FMDIFF^XLFDT(Y,X)>-1
SET RET=$$ERR^BGOUTL(1097)
QUIT
End DoDot:1
+25 IF RET
QUIT
+26 SET DFN=+$PIECE(INP,U,4)
+27 SET EVNTDT=$$CVTDATE^BGOUTL($PIECE(INP,U,5))
+28 IF EVNTDT=""
SET EVNTDT=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,1)
+29 SET PROCDT=$PIECE(EVNTDT,".",1)
+30 SET DX=$PIECE(INP,U,6)
+31 SET PRIN=$PIECE(INP,U,7)
+32 SET RET=$$FNDNARR^BGOUTL2($PIECE(INP,U,8))
+33 IF RET<0
QUIT
+34 SET NARR=$SELECT(RET:"`"_RET,1:"")
SET RET=""
+35 SET INFECT=$PIECE(INP,U,9)
+36 SET OPRPRV=$PIECE(INP,U,10)
+37 SET ANESTH=$PIECE(INP,U,11)
+38 SET ANESTIME=$PIECE(INP,U,12)
+39 SET LOCIEN=$PIECE(INP,U,13)
+40 SET OUTLOC=$PIECE(INP,U,14)
+41 SET HIST=$PIECE(INP,U,15)
+42 SET DUPS=$PIECE(INP,U,16)
+43 IF 'VIEN
IF 'HIST
SET RET=$$ERR^BGOUTL(1002)
QUIT
+44 SET VCAT=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,7)
+45 IF VCAT="E"
SET HIST=1
+46 IF HIST
Begin DoDot:1
+47 SET RET=$$MAKEHIST^BGOUTL(DFN,EVNTDT,$SELECT($LENGTH(OUTLOC):OUTLOC,1:LOCIEN),VIEN)
+48 IF RET>0
SET VIEN=RET
End DoDot:1
IF RET<0
QUIT
+49 SET RET=$$CHKVISIT^BGOUTL(VIEN,DFN)
+50 IF RET
QUIT
+51 IF 'VFIEN
Begin DoDot:1
+52 DO VFNEW^BGOUTL2(.RET,FNUM,TYPE,VIEN,$SELECT('DUPS:"Procedure",1:""))
+53 IF RET>0
SET VFIEN=RET
SET RET=""
End DoDot:1
IF 'VFIEN
QUIT
+54 SET FDA=$NAME(FDA(FNUM,VFIEN_","))
+55 SET @FDA@(.01)="`"_TYPE
+56 SET @FDA@(.04)=NARR
+57 SET @FDA@(.05)=$SELECT(DX:"`"_DX,1:"")
+58 SET @FDA@(.06)=PROCDT
+59 SET @FDA@(.07)=PRIN
+60 SET @FDA@(.08)=INFECT
+61 SET @FDA@(.11)=$SELECT(OPRPRV:"`"_OPRPRV,1:"")
+62 SET @FDA@(.12)=$SELECT(ANESTH:"`"_ANESTH,1:"")
+63 SET @FDA@(.13)=ANESTIME
+64 SET @FDA@(1201)=$SELECT(EVNTDT:EVNTDT,1:"N")
+65 SET @FDA@(1204)="`"_DUZ
+66 ;Patch 11 Set date entered
+67 IF VFNEW
Begin DoDot:1
+68 SET @FDA@(1216)="N"
+69 SET @FDA@(1217)="`"_DUZ
End DoDot:1
+70 ;Patch 11 Set last modified
+71 SET @FDA@(1218)="N"
+72 SET @FDA@(1219)="`"_DUZ
+73 SET RET=$$UPDATE^BGOUTL(.FDA,"E")
+74 IF RET
IF VFNEW
IF $$DELETE^BGOUTL(FNUM,VFIEN)
+75 IF 'RET
DO VFEVT^BGOUTL2(FNUM,VFIEN,'VFNEW)
+76 IF 'RET
SET RET=VFIEN
+77 QUIT
+78 ; INP = Lookup Value [1] ^ VIEN [2]
+79 ; LKP = Text to lookup
+80 ; VIEN = Visit IEN
LOOKUP(RET,INP) ;Lookup an ICD0 term with this call after AICD patch is installed
+1 NEW GBL,LKP,FROM,DIR,MAX,XREF,INP2,RET2,I,CNT,VIEN,VDT,ROOT,X,Y,VER,OUT,SYS
+2 NEW FLDS,IEN,IMP
+3 SET GBL=80.1
+4 SET RET=$$TMPGBL
+5 KILL ^TMP("ICD0",$JOB)
+6 SET LKP=$PIECE(INP,U,1)
+7 IF LKP=""
QUIT RET
+8 SET VIEN=$PIECE(INP,U,2)
+9 SET VDT=""
+10 IF +VIEN
SET VDT=$$GET1^DIQ(9000010,VIEN,.01,"I")
+11 IF VDT=""
SET VDT=DT
+12 SET FLDS=".01"
+13 SET CNT=0
+14 SET FROM=LKP
+15 SET DIR=1
+16 SET MAX=999
SET XREF="D"
+17 SET INP2="80.1"_U_LKP_U_FROM_U_DIR_U_MAX_U_XREF_"^^^"_U_VDT
+18 DO DICLKUP^BGOUTL(.RET2,INP2)
+19 MERGE RET=RET2
+20 QUIT
+21 ; Return V File #
FNUM() QUIT 9000010.08
TMPGBL(X) ;EP
+1 KILL ^TMP("BGOPRC",$JOB)
QUIT $NAME(^($JOB))
