- 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 Feb 19, 2025@00:11:40 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
