- 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))
