VPREVNT1 ;SLC/MKB -- VistA event listeners ;04/25/22 15:29
;;1.0;VIRTUAL PATIENT RECORD;**30**;Apr 05, 2022;Build 9
;;Per VA Directive 6402, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; DG PTF ICD DIAGNOSIS NOTIFIER 6850
; DG PTF ICD PROCEDURE NOTIFIER 7354
; DIC 2051
; XLFDT 10103
;
;
OPEVT ; -- DG PTF ICD PROCEDURE NOTIFIER protocol listener
N DFN,TYPE,IEN,PTF,ADM,VST,ROOT,FLD,FILE
S DFN=+$G(^TMP("DG PTF ICD OP NOTIFIER",$J,"DFN")) Q:DFN<1
F TYPE="PROCEDURE" D ;"DISCHARGE","SURGERY"
. S IEN=$G(^TMP("DG PTF ICD OP NOTIFIER",$J,TYPE,"IENS"))
. S:$E(IEN,$L(IEN))="," IEN=$E(IEN,1,$L(IEN)-1) ;strip final comma
. S PTF=$P(IEN,",",$L(IEN,",")) Q:PTF<1
. S ADM=$$FIND1^DIC(405,,"Q",PTF,"APTF"),VST=$$VNUM^VPRSDAV(ADM) Q:VST<1
. S ROOT=$NA(^TMP("DG PTF ICD OP NOTIFIER",$J,TYPE))
. S FLD="OPC" F S FLD=$O(@ROOT@(FLD)) Q:FLD'?1"OPC"2N D
.. S FILE=$S(TYPE="DISCHARGE":45,TYPE="PROCEDURE":45.05,TYPE="SURGERY":45.01,1:0)
.. D:FILE ICD("Procedure",FILE)
Q
;
DXEVT ; -- DG PTF ICD DIAGNOSIS NOTIFIER protocol listener
N DFN,IEN,ADM,VST,ROOT,FLD
S DFN=+$G(^TMP("DG PTF ICD NOTIFIER",$J,"DFN")) Q:DFN<1
S IEN=+$G(^TMP("DG PTF ICD NOTIFIER",$J,"DISCHARGE","IENS")) Q:IEN<1
S ADM=$$FIND1^DIC(405,,"Q",IEN,"APTF"),VST=$$VNUM^VPRSDAV(ADM) Q:VST<1
S ROOT=$NA(^TMP("DG PTF ICD NOTIFIER",$J,"DISCHARGE"))
I $D(@ROOT@("PDX")) S FLD="PDX" D ICD("Diagnosis",45) ;DXLS
; look for secondary dx
S FLD="SDX" F S FLD=$O(@ROOT@(FLD)) Q:FLD'?1"SDX"2N D ICD("Diagnosis",45)
Q
;
ICD(NAME,FN) ; -- process each ICD code
N ACT,ID,N,OLD,VPRSQ
S ACT="",ID=IEN,N=+$E(FLD,4,5) S:N ID=IEN_"-"_N
I $G(@ROOT@(FLD,"NEW"))="" S OLD=$G(@ROOT@(FLD,"OLD")),ACT="@"
D POST^VPRHS(DFN,NAME,ID_";"_FN,ACT,VST,.VPRSQ)
I ACT="@",$G(VPRSQ) D ;save ICD code for delete msg
. S ^XTMP("VPR-"_VPRSQ,ID)=DFN_U_NAME_U_ID_";"_FN_"^D^"_VST
. S ^XTMP("VPR-"_VPRSQ,ID,0)=OLD_U_U_VST
. S ^XTMP("VPR-"_VPRSQ,0)=$$FMADD^XLFDT(DT,14)_U_DT_"^Deleted record for AVPR"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPREVNT1 2154 printed Apr 09, 2024@21:47:43 Page 2
VPREVNT1 ;SLC/MKB -- VistA event listeners ;04/25/22 15:29
+1 ;;1.0;VIRTUAL PATIENT RECORD;**30**;Apr 05, 2022;Build 9
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; DG PTF ICD DIAGNOSIS NOTIFIER 6850
+7 ; DG PTF ICD PROCEDURE NOTIFIER 7354
+8 ; DIC 2051
+9 ; XLFDT 10103
+10 ;
+11 ;
OPEVT ; -- DG PTF ICD PROCEDURE NOTIFIER protocol listener
+1 NEW DFN,TYPE,IEN,PTF,ADM,VST,ROOT,FLD,FILE
+2 SET DFN=+$GET(^TMP("DG PTF ICD OP NOTIFIER",$JOB,"DFN"))
if DFN<1
QUIT
+3 ;"DISCHARGE","SURGERY"
FOR TYPE="PROCEDURE"
Begin DoDot:1
+4 SET IEN=$GET(^TMP("DG PTF ICD OP NOTIFIER",$JOB,TYPE,"IENS"))
+5 ;strip final comma
if $EXTRACT(IEN,$LENGTH(IEN))=","
SET IEN=$EXTRACT(IEN,1,$LENGTH(IEN)-1)
+6 SET PTF=$PIECE(IEN,",",$LENGTH(IEN,","))
if PTF<1
QUIT
+7 SET ADM=$$FIND1^DIC(405,,"Q",PTF,"APTF")
SET VST=$$VNUM^VPRSDAV(ADM)
if VST<1
QUIT
+8 SET ROOT=$NAME(^TMP("DG PTF ICD OP NOTIFIER",$JOB,TYPE))
+9 SET FLD="OPC"
FOR
SET FLD=$ORDER(@ROOT@(FLD))
if FLD'?1"OPC"2N
QUIT
Begin DoDot:2
+10 SET FILE=$SELECT(TYPE="DISCHARGE":45,TYPE="PROCEDURE":45.05,TYPE="SURGERY":45.01,1:0)
+11 if FILE
DO ICD("Procedure",FILE)
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
DXEVT ; -- DG PTF ICD DIAGNOSIS NOTIFIER protocol listener
+1 NEW DFN,IEN,ADM,VST,ROOT,FLD
+2 SET DFN=+$GET(^TMP("DG PTF ICD NOTIFIER",$JOB,"DFN"))
if DFN<1
QUIT
+3 SET IEN=+$GET(^TMP("DG PTF ICD NOTIFIER",$JOB,"DISCHARGE","IENS"))
if IEN<1
QUIT
+4 SET ADM=$$FIND1^DIC(405,,"Q",IEN,"APTF")
SET VST=$$VNUM^VPRSDAV(ADM)
if VST<1
QUIT
+5 SET ROOT=$NAME(^TMP("DG PTF ICD NOTIFIER",$JOB,"DISCHARGE"))
+6 ;DXLS
IF $DATA(@ROOT@("PDX"))
SET FLD="PDX"
DO ICD("Diagnosis",45)
+7 ; look for secondary dx
+8 SET FLD="SDX"
FOR
SET FLD=$ORDER(@ROOT@(FLD))
if FLD'?1"SDX"2N
QUIT
DO ICD("Diagnosis",45)
+9 QUIT
+10 ;
ICD(NAME,FN) ; -- process each ICD code
+1 NEW ACT,ID,N,OLD,VPRSQ
+2 SET ACT=""
SET ID=IEN
SET N=+$EXTRACT(FLD,4,5)
if N
SET ID=IEN_"-"_N
+3 IF $GET(@ROOT@(FLD,"NEW"))=""
SET OLD=$GET(@ROOT@(FLD,"OLD"))
SET ACT="@"
+4 DO POST^VPRHS(DFN,NAME,ID_";"_FN,ACT,VST,.VPRSQ)
+5 ;save ICD code for delete msg
IF ACT="@"
IF $GET(VPRSQ)
Begin DoDot:1
+6 SET ^XTMP("VPR-"_VPRSQ,ID)=DFN_U_NAME_U_ID_";"_FN_"^D^"_VST
+7 SET ^XTMP("VPR-"_VPRSQ,ID,0)=OLD_U_U_VST
+8 SET ^XTMP("VPR-"_VPRSQ,0)=$$FMADD^XLFDT(DT,14)_U_DT_"^Deleted record for AVPR"
End DoDot:1
+9 QUIT
