- VPREVNT ;SLC/MKB -- VistA event listeners ;10/25/18 15:29
- ;;1.0;VIRTUAL PATIENT RECORD;**8,10,15,17,19,21,20,26,25,27,29,31,34,33,35**;Sep 01, 2011;Build 16
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ; External References DBIA#
- ; ------------------- -----
- ; DG FIELD MONITOR 3344
- ; DG SA FILE ENTRY NOTIFIER 7232
- ; DGPM MOVEMENT EVENTS 1181
- ; GMPL EVENT 6065
- ; GMRA ASSESSMENT CHANGE 6986
- ; GMRA ENTERED IN ERROR 1467
- ; GMRA SIGN-OFF ON DATA 1469
- ; GMRA VERIFY DATA 1470
- ; IBCN NEW INSURANCE 7010
- ; MDC OBSERVATION UPDATE 6084
- ; PSB EVSEND VPR 6085
- ; PXK VISIT DATA EVENT 1298
- ; SCMC PATIENT TEAM CHANGES 7012
- ; SCMC PATIENT TEAM POSITION 7013
- ; SDAM APPOINTMENT EVENTS 1320
- ; TIU DOCUMENT ACTION EVENT 6774
- ; WV PREGNANCY STATUS CHANGE EVENT 7200
- ; ^AUPNPROB 5703
- ; ^AUPNVSIT 2028
- ; ^DGPM 1865
- ; ^DGS(41.1 3796
- ; ^DIC(42 10039
- ; ^DPT 10035
- ; ^GMR(120.8 6973
- ; ^GMR(120.86 3449
- ; ^TIU(8925.1 5677
- ; ^TIU(8925.7 7416
- ; %ZTLOAD 10063
- ; DIQ 2056
- ; XLFDT 10103
- ;
- DG ; -- DG FIELD MONITOR protocol listener
- ; [expects variables DGDA, DGFIELD, DGFILE]
- N VPRFN S VPRFN=$G(DGFILE)
- I "^2^2.01^2.02^2.06^38.1^"'[(U_VPRFN_U) Q
- N DFN S DFN=+$G(DGDA)
- ; collect individual fields into single tasked update if possible
- D QUE^VPRHS(DFN) Q ;skip fld check
- I VPRFN=2 D:$$FLD(+$G(DGFIELD)) QUE^VPRHS(DFN) Q
- D POST^VPRHS(DFN,"Patient",DFN_";2")
- Q
- ;
- FLD(X) ; -- Return 1 or 0, if X is a field tracked by VPR
- ; via DG FIELD MONITOR
- S X=U_+$G(X)_U
- I "^.01^.02^.03^.05^.07^.08^.09^.092^.093^.351^"[X Q 1 ;demographic
- I "^.111^.1112^.112^.113^.114^.115^.131^.132^.134^"[X Q 1 ;addr/phone
- I "^.211^.212^.213^.214^.216^.217^.218^.219^.21011^"[X Q 1 ;NOK
- I "^.331^.332^.333^.334^.335^.336^.337^.338^.339^"[X Q 1 ;ECON
- I "^.301^.302^.32102^.32103^.3215^.32201^.5295^"[X Q 1 ;serv conn
- I "^.14^.323^.361^1901^"[X Q 1
- Q 0
- ;
- NEWINPT() ; -- is DFN newly admitted?
- N Y S Y=0
- I DGPMT=1,DGPMA,'DGPMP,+$G(^DPT(DFN,.105))=DGPMDA S Y=1 ;new admission
- Q Y
- ;
- DGPM ; -- DGPM MOVEMENT EVENTS protocol listener
- ; [expects DFN,DGPM* variables]
- I $$NEWINPT,$$ON^VPRHS,'$$SUBS^VPRHS(DFN),$$VALID^VPRHS(DFN) D NEW^VPRHS(DFN) Q
- N ADM,VST,ADMA,ADMP
- I DGPMT'=1 D ;update related admission if not in ^UTILITY
- . S ADM=$S(DGPMA:+$P(DGPMA,U,14),1:+$P(DGPMP,U,14))
- . Q:$D(^UTILITY("DGPM",$J,1,ADM))
- . S VST=$$VNUM^VPRSDAV(ADM) Q:'VST
- . D POST^VPRHS(DFN,"Encounter",ADM_"~"_VST_";405")
- ; process all updated admissions
- S ADM=0 F S ADM=$O(^UTILITY("DGPM",$J,1,ADM)) Q:ADM<1 D
- . S ADMA=$G(^UTILITY("DGPM",$J,1,ADM,"A")),ADMP=$G(^("P"))
- . I ADMP,ADMA="" D CKVST Q ;deleted (still has Visit#)
- . S VST=$$VNUM^VPRSDAV(ADM) Q:'VST
- . D POST^VPRHS(DFN,"Encounter",ADM_"~"_VST_";405")
- Q
- CKVST ; -- delete visit if unused [from DGPM]
- N HLOC,VPRSQ
- S HLOC=+$G(^DIC(42,+$P(ADMP,U,6),44))
- S VST=$O(^AUPNVSIT("AET",DFN,+ADMP,HLOC,"P",0)) Q:'VST
- Q:$P($G(^AUPNVSIT(VST,0)),U,9)>0 ;D POST^VPRHS(DFN,"Encounter",VST_";9000010")
- ; save deleted encounter in ^XTMP - see DELALL^VPRENC
- K VPRSQ D POST^VPRHS(DFN,"Encounter",VST_";9000010","@",,.VPRSQ)
- I $G(VPRSQ) D SAVST^VPRENC(VPRSQ)
- Q
- ;
- DGS ; -- DG SA FILE ENTRY NOTIFIER protocol listener
- N IEN,DFN,ACT S ACT=""
- S IEN=+$G(^TMP("DG SA FILE ENTRY NOTIFIER",$J,"IEN")) Q:IEN<1
- S DFN=+$G(^TMP("DG SA FILE ENTRY NOTIFIER",$J,"DFN","CURRENT"))
- I DFN<1 S DFN=+$G(^TMP("DG SA FILE ENTRY NOTIFIER",$J,"DFN","OLD")) Q:DFN<1
- ;I $G(^TMP("DG SA FILE ENTRY NOTIFIER",$J,"ACTION"))="DELETED" S ACT="@"
- ;I $G(^TMP("DG SA FILE ENTRY NOTIFIER",$J,"ACTION"))="MODIFIED",$P($G(^DGS(41.1,IEN,0)),U,13) S ACT="@"
- D POST^VPRHS(DFN,"Appointment",IEN_";41.1",ACT)
- Q
- ;
- SDAM ; -- SDAM APPOINTMENT EVENTS protocol listener
- ; [expects variables SDATA, SDAMEVT]
- N DFN,DATE,ACT Q:'$G(SDATA)
- Q:$G(SDAMEVT)>5 ;only track make, cancel, no show, check in/out
- ; quit if status has not changed
- Q:$G(SDATA("BEFORE","STATUS"))=$G(SDATA("AFTER","STATUS"))
- S DFN=+$P(SDATA,U,2) Q:DFN<1
- S DATE=+$P(SDATA,U,3),ACT="" ;ACT=$S($G(SDAMEVT)=2:"@",1:"")
- D POST^VPRHS(DFN,"Appointment",(DATE_","_DFN_";2.98"),ACT)
- Q
- ;
- GMRA(ACT) ; -- GMRA SIGN-OFF ON DATA protocol listener
- ; also GMRA ENTERED IN ERROR [ACT=@]
- ; [expects GMRAPA variables]
- N DFN,IEN,NEW,I
- S DFN=+$G(GMRAPA(0)),IEN=+$G(GMRAPA)
- D POST^VPRHS(DFN,"Allergy",IEN_";120.8") ;,$G(ACT))
- Q
- ;
- GMRASMT(DFN) ; -- GMRA ASSESSMENT CHANGE listener
- N ACT S ACT=$S($P($G(^GMR(120.86,DFN,0)),U,2):"@",1:"")
- D POST^VPRHS(DFN,"Allergy",DFN_";120.86",ACT)
- Q
- ;
- GMPL(DFN,IEN) ; -- GMPL EVENT protocol listener
- S DFN=+$G(DFN),IEN=+$G(IEN)
- N ACT S ACT=$S($P($G(^AUPNPROB(IEN,1)),U,2)="H":"@",1:"")
- D POST^VPRHS(DFN,"Problem",IEN_";9000011",ACT)
- Q
- ;
- GMRV(DFN,IEN,ERR) ; -- Vital Measurement file #120.5 AVPR index
- S DFN=+$G(DFN),IEN=+$G(IEN)
- N ACT S ACT=$S($G(ERR):"@",1:"")
- D POST^VPRHS(DFN,"Observation",IEN_";120.5",ACT)
- Q
- ;
- CP(DFN,ID,ACT) ; -- CP Transaction file #702 AVPR index
- Q ; via VPRPROC [no longer used]
- S DFN=+$G(DFN),ID=+$G(ID)
- N VST S VST=$$GET1^DIQ(702,ID,".06:.03","I")
- D POST^VPRHS(DFN,"Procedure",ID_";702",$G(ACT),VST)
- Q
- ;
- TIU(DFN,IEN) ; -- TIU Document file #8925 AEVT index
- ; [expects X, X1, X2 arrays from FM]
- N STS,DAD,ACT
- S DFN=+$G(DFN),IEN=+$G(IEN) Q:DFN<1 Q:IEN<1
- S STS=$G(X(2)),DAD=$G(X(3)) ;X = FM data array for index
- I STS<7 Q ;not complete
- I STS=9 Q ;archived, leave in cache unchanged
- I STS>13 Q ;removed, handled via protocol
- S:DAD IEN=DAD ;if addendum, repull entire note
- S ACT=$S(X2(2)&(X1(2)=""):1,X1&(X2=""):"@",1:"") ;add/remove amendment
- D TIU^VPRENC(IEN,ACT) ;add to ^XTMP("VPRPX") encounter list
- Q
- ;
- TIUR ; -- TIU DOCUMENT ACTION EVENT listener (removing notes)
- N ARY,ACT,DFN,IEN,VST,DAD,X,VPRSQ,CLS
- S ARY=$NA(^TMP("TIUDOCACT",$J)),ACT=$G(@ARY@("ACTION"))
- I ACT="RETRACT" D Q:IEN<1 G TRQ ;not DELETE
- . S DFN=+$G(@ARY@("PATIENT")),VST=$G(@ARY@("VISIT"))
- . S IEN=+$G(@ARY@("DOCUMENT")) Q:IEN<1 Q:DFN<1
- . S DAD=+$$GET1^DIQ(8925,IEN,.06,"I") Q:'DAD
- . ; update parent unless already retracted
- . S IEN=$S($$GET1^DIQ(8925,DAD,.05,"I")=15:0,1:DAD)
- ;
- Q:ACT'="REASSIGN"
- S DFN=+$G(@ARY@("PATIENT","OLD")),VST=$G(@ARY@("VISIT","OLD"))
- S IEN=+$G(@ARY@("DOCUMENT","OLD")) ;DA in NEW if patient unchanged
- S:IEN<1 IEN=+$G(@ARY@("DOCUMENT","NEW")) Q:IEN<1 Q:DFN<1
- S DAD=+$$GET1^DIQ(8925,IEN,.06,"I") I DAD D TIU^VPRENC(DAD) Q
- ; new document saved via regular index event
- TRQ ; remove document from old patient/visit
- S ACT=$S($G(DAD):"",1:"@") ;update parent if retracting addendum
- D POST^VPRHS(DFN,"Document",IEN_";8925",ACT,VST,.VPRSQ)
- I ACT="@",$G(VPRSQ) D ;save visit
- . S ^XTMP("VPR-"_VPRSQ,IEN)=DFN_"^Document^"_IEN_";8925^D^"_VST
- . S X=+$$GET1^DIQ(8925,IEN,.01,"I"),^XTMP("VPR-"_VPRSQ,IEN,0)=X_U_DFN_U_VST
- . S ^XTMP("VPR-"_VPRSQ,0)=$$FMADD^XLFDT(DT,14)_U_DT_"^Deleted record for AVPR"
- S CLS=$$GET1^DIQ(8925,IEN,.04,"I")
- D:CLS=27 POST^VPRHS(DFN,"AdvanceDirective",IEN_";8925",ACT)
- D:CLS=30!(CLS=31) POST^VPRHS(DFN,"Alert",IEN_";8925",ACT)
- Q
- ;
- TIUS(IEN) ; -- TIU MULTIPLE SIGNATURE file #8925.7 AVPR index
- S IEN=+$G(IEN) Q:IEN<1
- N TIU0,TIUIEN,DFN,VST
- S TIU0=$G(^TIU(8925.7,IEN,0)),TIUIEN=+$P(TIU0,U) Q:TIUIEN<1
- S DFN=$$GET1^DIQ(8925,TIUIEN,.02,"I") Q:DFN<1
- S VST=$$GET1^DIQ(8925,TIUIEN,.03,"I") ;Ok if null
- ; non-PCE event so post immediately for BMS
- D POST^VPRHS(DFN,"Document",TIUIEN_";8925",,VST)
- Q
- ;
- IBCN ; -- IBCN NEW INSURANCE EVENTS listener
- ; expects IBCDFN, IBEVTACT="ADD","EDT", or "DEL"
- I '$G(IBCDFN) Q
- N ACT,ID,VPRSQ,I S ID=IBCDFN_","_DFN
- S ACT=$S($G(IBEVTACT)="DEL":"@",$G(IBEVTACT)="ADD":"",1:$$IBDIFF)
- D POST^VPRHS(DFN,"MemberEnrollment",ID_";2.312",ACT,,.VPRSQ)
- I ACT="@",$G(VPRSQ) D ;save old values for delete msg
- . S ^XTMP("VPR-"_VPRSQ,ID)=DFN_"^MemberEnrollment^"_ID_";2.312^D^"
- . F I=0,1,2,3,7 S ^XTMP("VPR-"_VPRSQ,ID,I)=$G(@("IBEVTP"_I))
- . S ^XTMP("VPR-"_VPRSQ,0)=$$FMADD^XLFDT(DT,14)_U_DT_"^Deleted record for AVPR"
- I ($G(IBEVTACT)="EDT")&(ACT="@") D ;task edit to ensure delete happens first
- . N ZTRTN,ZTDTH,ZTDESC,ZTIO,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC,ZTSK
- . S ZTRTN="IBTASK^VPREVNT",ZTDESC="VPR Insurance Update",ZTIO=""
- . S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,,,2),ZTSAVE("DFN")="",ZTSAVE("ID")=""
- . D ^%ZTLOAD
- Q
- IBDIFF() ; -- return 1 or 0, if key matching values changed
- I +$G(IBEVTP0)'=+$G(IBEVTA0) Q 1
- I $P($G(IBEVTP0),U,18)'=$P($G(IBEVTA0),U,18) Q 1
- I $P($G(IBEVTP7),U,2)'=$P($G(IBEVTA7),U,2) Q 1
- Q 0
- IBTASK ; -- tasked update
- Q:'$G(DFN) Q:'$G(ID)
- D POST^VPRHS(DFN,"MemberEnrollment",ID_";2.312")
- Q
- ;
- PCMMT ; -- SCMC PATIENT TEAM CHANGES protocol listener
- ; [expects SCPTTM* variables]
- ;I '$G(SCPCTM) Q ;not pc change
- N DFN S DFN=$S($G(SCPTTMAF):+SCPTTMAF,1:+$G(SCPTTMB4)) Q:'DFN
- D QUE^VPRHS(DFN) ;POST^VPRHS(DFN,"Patient",DFN_";2")
- Q
- ;
- PCMMTP ; -- SCMC PATIENT TEAM POSITION CHANGES protocol listener
- ; [expects SCPTTP* variables]
- ;I '$G(SCPCTP) Q ;not pc change
- N TM,DFN
- S TM=$S($G(SCPTTPAF):+SCPTTPAF,1:+$G(SCPTTPB4)) Q:'TM
- S DFN=+$$GET1^DIQ(404.42,TM_",",.01,"I")
- D QUE^VPRHS(DFN) ;POST^VPRHS(DFN,"Patient",DFN_";2")
- Q
- ;
- WV ; -- WV PREGNANCY STATUS CHANGE EVENT protocol listener
- N VPRPREG,VPRDFN,VPRFLD,VPRFLAG
- M VPRPREG=^TMP("WVPREGST",$J)
- Q:'$D(VPRPREG)
- S VPRDFN=+$P($G(VPRPREG("AFTER","EXTERNAL ID")),",",2)
- Q:VPRDFN=0
- ; if no before value, then new record, post
- I '$D(VPRPREG("BEFORE")) D POST^VPRHS(VPRDFN,"SocialHistory",VPRDFN_";790.05") Q
- Q:VPRDFN'=+$P($G(VPRPREG("BEFORE","EXTERNAL ID")),",",2)
- ; if external ids do not match, then additional record, post
- I $G(VPRPREG("BEFORE","EXTERNAL ID"))'=$G(VPRPREG("AFTER","EXTERNAL ID")) D POST^VPRHS(VPRDFN,"SocialHistory",VPRDFN_";790.05") Q
- ; if change in fields we send to HS, post
- S VPRFLAG=0
- F VPRFLD="FROM TIME","STATE","STATUS","TO TIME" S:$G(VPRPREG("BEFORE",VPRFLD))'=$G(VPRPREG("AFTER",VPRFLD)) VPRFLAG=1 Q:VPRFLAG=1
- I VPRFLAG=1 D POST^VPRHS(VPRDFN,"SocialHistory",VPRDFN_";790.05")
- Q
- ;
- ; Deprecated calls:
- ;
- DOCDEF(IEN) ; -- TIU Document Definition file #8925.1 AVPR index
- Q
- ;
- DOCITM(DAD) ; -- TIU Document Def'n Items subfile #8925.14 AVPR1 index
- Q
- ;
- USR(IEN) ; -- USR Authorization/Subscription file #8930.1 AVPR index
- Q
- ;
- XU(IEN,ACT) ; -- XU USER ADD/CHANGE/TERMINATE option listener
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPREVNT 11123 printed Jan 18, 2025@03:46:19 Page 2
- VPREVNT ;SLC/MKB -- VistA event listeners ;10/25/18 15:29
- +1 ;;1.0;VIRTUAL PATIENT RECORD;**8,10,15,17,19,21,20,26,25,27,29,31,34,33,35**;Sep 01, 2011;Build 16
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ; External References DBIA#
- +5 ; ------------------- -----
- +6 ; DG FIELD MONITOR 3344
- +7 ; DG SA FILE ENTRY NOTIFIER 7232
- +8 ; DGPM MOVEMENT EVENTS 1181
- +9 ; GMPL EVENT 6065
- +10 ; GMRA ASSESSMENT CHANGE 6986
- +11 ; GMRA ENTERED IN ERROR 1467
- +12 ; GMRA SIGN-OFF ON DATA 1469
- +13 ; GMRA VERIFY DATA 1470
- +14 ; IBCN NEW INSURANCE 7010
- +15 ; MDC OBSERVATION UPDATE 6084
- +16 ; PSB EVSEND VPR 6085
- +17 ; PXK VISIT DATA EVENT 1298
- +18 ; SCMC PATIENT TEAM CHANGES 7012
- +19 ; SCMC PATIENT TEAM POSITION 7013
- +20 ; SDAM APPOINTMENT EVENTS 1320
- +21 ; TIU DOCUMENT ACTION EVENT 6774
- +22 ; WV PREGNANCY STATUS CHANGE EVENT 7200
- +23 ; ^AUPNPROB 5703
- +24 ; ^AUPNVSIT 2028
- +25 ; ^DGPM 1865
- +26 ; ^DGS(41.1 3796
- +27 ; ^DIC(42 10039
- +28 ; ^DPT 10035
- +29 ; ^GMR(120.8 6973
- +30 ; ^GMR(120.86 3449
- +31 ; ^TIU(8925.1 5677
- +32 ; ^TIU(8925.7 7416
- +33 ; %ZTLOAD 10063
- +34 ; DIQ 2056
- +35 ; XLFDT 10103
- +36 ;
- DG ; -- DG FIELD MONITOR protocol listener
- +1 ; [expects variables DGDA, DGFIELD, DGFILE]
- +2 NEW VPRFN
- SET VPRFN=$GET(DGFILE)
- +3 IF "^2^2.01^2.02^2.06^38.1^"'[(U_VPRFN_U)
- QUIT
- +4 NEW DFN
- SET DFN=+$GET(DGDA)
- +5 ; collect individual fields into single tasked update if possible
- +6 ;skip fld check
- DO QUE^VPRHS(DFN)
- QUIT
- +7 IF VPRFN=2
- if $$FLD(+$GET(DGFIELD))
- DO QUE^VPRHS(DFN)
- QUIT
- +8 DO POST^VPRHS(DFN,"Patient",DFN_";2")
- +9 QUIT
- +10 ;
- FLD(X) ; -- Return 1 or 0, if X is a field tracked by VPR
- +1 ; via DG FIELD MONITOR
- +2 SET X=U_+$GET(X)_U
- +3 ;demographic
- IF "^.01^.02^.03^.05^.07^.08^.09^.092^.093^.351^"[X
- QUIT 1
- +4 ;addr/phone
- IF "^.111^.1112^.112^.113^.114^.115^.131^.132^.134^"[X
- QUIT 1
- +5 ;NOK
- IF "^.211^.212^.213^.214^.216^.217^.218^.219^.21011^"[X
- QUIT 1
- +6 ;ECON
- IF "^.331^.332^.333^.334^.335^.336^.337^.338^.339^"[X
- QUIT 1
- +7 ;serv conn
- IF "^.301^.302^.32102^.32103^.3215^.32201^.5295^"[X
- QUIT 1
- +8 IF "^.14^.323^.361^1901^"[X
- QUIT 1
- +9 QUIT 0
- +10 ;
- NEWINPT() ; -- is DFN newly admitted?
- +1 NEW Y
- SET Y=0
- +2 ;new admission
- IF DGPMT=1
- IF DGPMA
- IF 'DGPMP
- IF +$GET(^DPT(DFN,.105))=DGPMDA
- SET Y=1
- +3 QUIT Y
- +4 ;
- DGPM ; -- DGPM MOVEMENT EVENTS protocol listener
- +1 ; [expects DFN,DGPM* variables]
- +2 IF $$NEWINPT
- IF $$ON^VPRHS
- IF '$$SUBS^VPRHS(DFN)
- IF $$VALID^VPRHS(DFN)
- DO NEW^VPRHS(DFN)
- QUIT
- +3 NEW ADM,VST,ADMA,ADMP
- +4 ;update related admission if not in ^UTILITY
- IF DGPMT'=1
- Begin DoDot:1
- +5 SET ADM=$SELECT(DGPMA:+$PIECE(DGPMA,U,14),1:+$PIECE(DGPMP,U,14))
- +6 if $DATA(^UTILITY("DGPM",$JOB,1,ADM))
- QUIT
- +7 SET VST=$$VNUM^VPRSDAV(ADM)
- if 'VST
- QUIT
- +8 DO POST^VPRHS(DFN,"Encounter",ADM_"~"_VST_";405")
- End DoDot:1
- +9 ; process all updated admissions
- +10 SET ADM=0
- FOR
- SET ADM=$ORDER(^UTILITY("DGPM",$JOB,1,ADM))
- if ADM<1
- QUIT
- Begin DoDot:1
- +11 SET ADMA=$GET(^UTILITY("DGPM",$JOB,1,ADM,"A"))
- SET ADMP=$GET(^("P"))
- +12 ;deleted (still has Visit#)
- IF ADMP
- IF ADMA=""
- DO CKVST
- QUIT
- +13 SET VST=$$VNUM^VPRSDAV(ADM)
- if 'VST
- QUIT
- +14 DO POST^VPRHS(DFN,"Encounter",ADM_"~"_VST_";405")
- End DoDot:1
- +15 QUIT
- CKVST ; -- delete visit if unused [from DGPM]
- +1 NEW HLOC,VPRSQ
- +2 SET HLOC=+$GET(^DIC(42,+$PIECE(ADMP,U,6),44))
- +3 SET VST=$ORDER(^AUPNVSIT("AET",DFN,+ADMP,HLOC,"P",0))
- if 'VST
- QUIT
- +4 ;D POST^VPRHS(DFN,"Encounter",VST_";9000010")
- if $PIECE($GET(^AUPNVSIT(VST,0)),U,9)>0
- QUIT
- +5 ; save deleted encounter in ^XTMP - see DELALL^VPRENC
- +6 KILL VPRSQ
- DO POST^VPRHS(DFN,"Encounter",VST_";9000010","@",,.VPRSQ)
- +7 IF $GET(VPRSQ)
- DO SAVST^VPRENC(VPRSQ)
- +8 QUIT
- +9 ;
- DGS ; -- DG SA FILE ENTRY NOTIFIER protocol listener
- +1 NEW IEN,DFN,ACT
- SET ACT=""
- +2 SET IEN=+$GET(^TMP("DG SA FILE ENTRY NOTIFIER",$JOB,"IEN"))
- if IEN<1
- QUIT
- +3 SET DFN=+$GET(^TMP("DG SA FILE ENTRY NOTIFIER",$JOB,"DFN","CURRENT"))
- +4 IF DFN<1
- SET DFN=+$GET(^TMP("DG SA FILE ENTRY NOTIFIER",$JOB,"DFN","OLD"))
- if DFN<1
- QUIT
- +5 ;I $G(^TMP("DG SA FILE ENTRY NOTIFIER",$J,"ACTION"))="DELETED" S ACT="@"
- +6 ;I $G(^TMP("DG SA FILE ENTRY NOTIFIER",$J,"ACTION"))="MODIFIED",$P($G(^DGS(41.1,IEN,0)),U,13) S ACT="@"
- +7 DO POST^VPRHS(DFN,"Appointment",IEN_";41.1",ACT)
- +8 QUIT
- +9 ;
- SDAM ; -- SDAM APPOINTMENT EVENTS protocol listener
- +1 ; [expects variables SDATA, SDAMEVT]
- +2 NEW DFN,DATE,ACT
- if '$GET(SDATA)
- QUIT
- +3 ;only track make, cancel, no show, check in/out
- if $GET(SDAMEVT)>5
- QUIT
- +4 ; quit if status has not changed
- +5 if $GET(SDATA("BEFORE","STATUS"))=$GET(SDATA("AFTER","STATUS"))
- QUIT
- +6 SET DFN=+$PIECE(SDATA,U,2)
- if DFN<1
- QUIT
- +7 ;ACT=$S($G(SDAMEVT)=2:"@",1:"")
- SET DATE=+$PIECE(SDATA,U,3)
- SET ACT=""
- +8 DO POST^VPRHS(DFN,"Appointment",(DATE_","_DFN_";2.98"),ACT)
- +9 QUIT
- +10 ;
- GMRA(ACT) ; -- GMRA SIGN-OFF ON DATA protocol listener
- +1 ; also GMRA ENTERED IN ERROR [ACT=@]
- +2 ; [expects GMRAPA variables]
- +3 NEW DFN,IEN,NEW,I
- +4 SET DFN=+$GET(GMRAPA(0))
- SET IEN=+$GET(GMRAPA)
- +5 ;,$G(ACT))
- DO POST^VPRHS(DFN,"Allergy",IEN_";120.8")
- +6 QUIT
- +7 ;
- GMRASMT(DFN) ; -- GMRA ASSESSMENT CHANGE listener
- +1 NEW ACT
- SET ACT=$SELECT($PIECE($GET(^GMR(120.86,DFN,0)),U,2):"@",1:"")
- +2 DO POST^VPRHS(DFN,"Allergy",DFN_";120.86",ACT)
- +3 QUIT
- +4 ;
- GMPL(DFN,IEN) ; -- GMPL EVENT protocol listener
- +1 SET DFN=+$GET(DFN)
- SET IEN=+$GET(IEN)
- +2 NEW ACT
- SET ACT=$SELECT($PIECE($GET(^AUPNPROB(IEN,1)),U,2)="H":"@",1:"")
- +3 DO POST^VPRHS(DFN,"Problem",IEN_";9000011",ACT)
- +4 QUIT
- +5 ;
- GMRV(DFN,IEN,ERR) ; -- Vital Measurement file #120.5 AVPR index
- +1 SET DFN=+$GET(DFN)
- SET IEN=+$GET(IEN)
- +2 NEW ACT
- SET ACT=$SELECT($GET(ERR):"@",1:"")
- +3 DO POST^VPRHS(DFN,"Observation",IEN_";120.5",ACT)
- +4 QUIT
- +5 ;
- CP(DFN,ID,ACT) ; -- CP Transaction file #702 AVPR index
- +1 ; via VPRPROC [no longer used]
- QUIT
- +2 SET DFN=+$GET(DFN)
- SET ID=+$GET(ID)
- +3 NEW VST
- SET VST=$$GET1^DIQ(702,ID,".06:.03","I")
- +4 DO POST^VPRHS(DFN,"Procedure",ID_";702",$GET(ACT),VST)
- +5 QUIT
- +6 ;
- TIU(DFN,IEN) ; -- TIU Document file #8925 AEVT index
- +1 ; [expects X, X1, X2 arrays from FM]
- +2 NEW STS,DAD,ACT
- +3 SET DFN=+$GET(DFN)
- SET IEN=+$GET(IEN)
- if DFN<1
- QUIT
- if IEN<1
- QUIT
- +4 ;X = FM data array for index
- SET STS=$GET(X(2))
- SET DAD=$GET(X(3))
- +5 ;not complete
- IF STS<7
- QUIT
- +6 ;archived, leave in cache unchanged
- IF STS=9
- QUIT
- +7 ;removed, handled via protocol
- IF STS>13
- QUIT
- +8 ;if addendum, repull entire note
- if DAD
- SET IEN=DAD
- +9 ;add/remove amendment
- SET ACT=$SELECT(X2(2)&(X1(2)=""):1,X1&(X2=""):"@",1:"")
- +10 ;add to ^XTMP("VPRPX") encounter list
- DO TIU^VPRENC(IEN,ACT)
- +11 QUIT
- +12 ;
- TIUR ; -- TIU DOCUMENT ACTION EVENT listener (removing notes)
- +1 NEW ARY,ACT,DFN,IEN,VST,DAD,X,VPRSQ,CLS
- +2 SET ARY=$NAME(^TMP("TIUDOCACT",$JOB))
- SET ACT=$GET(@ARY@("ACTION"))
- +3 ;not DELETE
- IF ACT="RETRACT"
- Begin DoDot:1
- +4 SET DFN=+$GET(@ARY@("PATIENT"))
- SET VST=$GET(@ARY@("VISIT"))
- +5 SET IEN=+$GET(@ARY@("DOCUMENT"))
- if IEN<1
- QUIT
- if DFN<1
- QUIT
- +6 SET DAD=+$$GET1^DIQ(8925,IEN,.06,"I")
- if 'DAD
- QUIT
- +7 ; update parent unless already retracted
- +8 SET IEN=$SELECT($$GET1^DIQ(8925,DAD,.05,"I")=15:0,1:DAD)
- End DoDot:1
- if IEN<1
- QUIT
- GOTO TRQ
- +9 ;
- +10 if ACT'="REASSIGN"
- QUIT
- +11 SET DFN=+$GET(@ARY@("PATIENT","OLD"))
- SET VST=$GET(@ARY@("VISIT","OLD"))
- +12 ;DA in NEW if patient unchanged
- SET IEN=+$GET(@ARY@("DOCUMENT","OLD"))
- +13 if IEN<1
- SET IEN=+$GET(@ARY@("DOCUMENT","NEW"))
- if IEN<1
- QUIT
- if DFN<1
- QUIT
- +14 SET DAD=+$$GET1^DIQ(8925,IEN,.06,"I")
- IF DAD
- DO TIU^VPRENC(DAD)
- QUIT
- +15 ; new document saved via regular index event
- TRQ ; remove document from old patient/visit
- +1 ;update parent if retracting addendum
- SET ACT=$SELECT($GET(DAD):"",1:"@")
- +2 DO POST^VPRHS(DFN,"Document",IEN_";8925",ACT,VST,.VPRSQ)
- +3 ;save visit
- IF ACT="@"
- IF $GET(VPRSQ)
- Begin DoDot:1
- +4 SET ^XTMP("VPR-"_VPRSQ,IEN)=DFN_"^Document^"_IEN_";8925^D^"_VST
- +5 SET X=+$$GET1^DIQ(8925,IEN,.01,"I")
- SET ^XTMP("VPR-"_VPRSQ,IEN,0)=X_U_DFN_U_VST
- +6 SET ^XTMP("VPR-"_VPRSQ,0)=$$FMADD^XLFDT(DT,14)_U_DT_"^Deleted record for AVPR"
- End DoDot:1
- +7 SET CLS=$$GET1^DIQ(8925,IEN,.04,"I")
- +8 if CLS=27
- DO POST^VPRHS(DFN,"AdvanceDirective",IEN_";8925",ACT)
- +9 if CLS=30!(CLS=31)
- DO POST^VPRHS(DFN,"Alert",IEN_";8925",ACT)
- +10 QUIT
- +11 ;
- TIUS(IEN) ; -- TIU MULTIPLE SIGNATURE file #8925.7 AVPR index
- +1 SET IEN=+$GET(IEN)
- if IEN<1
- QUIT
- +2 NEW TIU0,TIUIEN,DFN,VST
- +3 SET TIU0=$GET(^TIU(8925.7,IEN,0))
- SET TIUIEN=+$PIECE(TIU0,U)
- if TIUIEN<1
- QUIT
- +4 SET DFN=$$GET1^DIQ(8925,TIUIEN,.02,"I")
- if DFN<1
- QUIT
- +5 ;Ok if null
- SET VST=$$GET1^DIQ(8925,TIUIEN,.03,"I")
- +6 ; non-PCE event so post immediately for BMS
- +7 DO POST^VPRHS(DFN,"Document",TIUIEN_";8925",,VST)
- +8 QUIT
- +9 ;
- IBCN ; -- IBCN NEW INSURANCE EVENTS listener
- +1 ; expects IBCDFN, IBEVTACT="ADD","EDT", or "DEL"
- +2 IF '$GET(IBCDFN)
- QUIT
- +3 NEW ACT,ID,VPRSQ,I
- SET ID=IBCDFN_","_DFN
- +4 SET ACT=$SELECT($GET(IBEVTACT)="DEL":"@",$GET(IBEVTACT)="ADD":"",1:$$IBDIFF)
- +5 DO POST^VPRHS(DFN,"MemberEnrollment",ID_";2.312",ACT,,.VPRSQ)
- +6 ;save old values for delete msg
- IF ACT="@"
- IF $GET(VPRSQ)
- Begin DoDot:1
- +7 SET ^XTMP("VPR-"_VPRSQ,ID)=DFN_"^MemberEnrollment^"_ID_";2.312^D^"
- +8 FOR I=0,1,2,3,7
- SET ^XTMP("VPR-"_VPRSQ,ID,I)=$GET(@("IBEVTP"_I))
- +9 SET ^XTMP("VPR-"_VPRSQ,0)=$$FMADD^XLFDT(DT,14)_U_DT_"^Deleted record for AVPR"
- End DoDot:1
- +10 ;task edit to ensure delete happens first
- IF ($GET(IBEVTACT)="EDT")&(ACT="@")
- Begin DoDot:1
- +11 NEW ZTRTN,ZTDTH,ZTDESC,ZTIO,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC,ZTSK
- +12 SET ZTRTN="IBTASK^VPREVNT"
- SET ZTDESC="VPR Insurance Update"
- SET ZTIO=""
- +13 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,,,2)
- SET ZTSAVE("DFN")=""
- SET ZTSAVE("ID")=""
- +14 DO ^%ZTLOAD
- End DoDot:1
- +15 QUIT
- IBDIFF() ; -- return 1 or 0, if key matching values changed
- +1 IF +$GET(IBEVTP0)'=+$GET(IBEVTA0)
- QUIT 1
- +2 IF $PIECE($GET(IBEVTP0),U,18)'=$PIECE($GET(IBEVTA0),U,18)
- QUIT 1
- +3 IF $PIECE($GET(IBEVTP7),U,2)'=$PIECE($GET(IBEVTA7),U,2)
- QUIT 1
- +4 QUIT 0
- IBTASK ; -- tasked update
- +1 if '$GET(DFN)
- QUIT
- if '$GET(ID)
- QUIT
- +2 DO POST^VPRHS(DFN,"MemberEnrollment",ID_";2.312")
- +3 QUIT
- +4 ;
- PCMMT ; -- SCMC PATIENT TEAM CHANGES protocol listener
- +1 ; [expects SCPTTM* variables]
- +2 ;I '$G(SCPCTM) Q ;not pc change
- +3 NEW DFN
- SET DFN=$SELECT($GET(SCPTTMAF):+SCPTTMAF,1:+$GET(SCPTTMB4))
- if 'DFN
- QUIT
- +4 ;POST^VPRHS(DFN,"Patient",DFN_";2")
- DO QUE^VPRHS(DFN)
- +5 QUIT
- +6 ;
- PCMMTP ; -- SCMC PATIENT TEAM POSITION CHANGES protocol listener
- +1 ; [expects SCPTTP* variables]
- +2 ;I '$G(SCPCTP) Q ;not pc change
- +3 NEW TM,DFN
- +4 SET TM=$SELECT($GET(SCPTTPAF):+SCPTTPAF,1:+$GET(SCPTTPB4))
- if 'TM
- QUIT
- +5 SET DFN=+$$GET1^DIQ(404.42,TM_",",.01,"I")
- +6 ;POST^VPRHS(DFN,"Patient",DFN_";2")
- DO QUE^VPRHS(DFN)
- +7 QUIT
- +8 ;
- WV ; -- WV PREGNANCY STATUS CHANGE EVENT protocol listener
- +1 NEW VPRPREG,VPRDFN,VPRFLD,VPRFLAG
- +2 MERGE VPRPREG=^TMP("WVPREGST",$JOB)
- +3 if '$DATA(VPRPREG)
- QUIT
- +4 SET VPRDFN=+$PIECE($GET(VPRPREG("AFTER","EXTERNAL ID")),",",2)
- +5 if VPRDFN=0
- QUIT
- +6 ; if no before value, then new record, post
- +7 IF '$DATA(VPRPREG("BEFORE"))
- DO POST^VPRHS(VPRDFN,"SocialHistory",VPRDFN_";790.05")
- QUIT
- +8 if VPRDFN'=+$PIECE($GET(VPRPREG("BEFORE","EXTERNAL ID")),",",2)
- QUIT
- +9 ; if external ids do not match, then additional record, post
- +10 IF $GET(VPRPREG("BEFORE","EXTERNAL ID"))'=$GET(VPRPREG("AFTER","EXTERNAL ID"))
- DO POST^VPRHS(VPRDFN,"SocialHistory",VPRDFN_";790.05")
- QUIT
- +11 ; if change in fields we send to HS, post
- +12 SET VPRFLAG=0
- +13 FOR VPRFLD="FROM TIME","STATE","STATUS","TO TIME"
- if $GET(VPRPREG("BEFORE",VPRFLD))'=$GET(VPRPREG("AFTER",VPRFLD))
- SET VPRFLAG=1
- if VPRFLAG=1
- QUIT
- +14 IF VPRFLAG=1
- DO POST^VPRHS(VPRDFN,"SocialHistory",VPRDFN_";790.05")
- +15 QUIT
- +16 ;
- +17 ; Deprecated calls:
- +18 ;
- DOCDEF(IEN) ; -- TIU Document Definition file #8925.1 AVPR index
- +1 QUIT
- +2 ;
- DOCITM(DAD) ; -- TIU Document Def'n Items subfile #8925.14 AVPR1 index
- +1 QUIT
- +2 ;
- USR(IEN) ; -- USR Authorization/Subscription file #8930.1 AVPR index
- +1 QUIT
- +2 ;
- XU(IEN,ACT) ; -- XU USER ADD/CHANGE/TERMINATE option listener
- +1 QUIT