Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VPRENC

VPRENC.m

Go to the documentation of this file.
  1. VPRENC ;SLC/MKB -- VistA Encounter updates ;10/25/18 15:29
  1. ;;1.0;VIRTUAL PATIENT RECORD;**19,20,26,25,27,28,29**;Sep 01, 2011;Build 11
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Collect all visit changes in (NOW = time last modified):
  1. ;^XTMP("VPRPX",0) = DT+2 ^ DT ^ VPR ENCOUNTERS
  1. ;^XTMP("VPRPX", visit~dfn) = NOW ^ ID ^ NEW ^ VTYP
  1. ;^XTMP("VPRPX", visit~dfn, "SUB", ien) = NEW
  1. ;^XTMP("VPRPX", visit~dfn, "SUB", ien, 0) = BEFORE 0-node, if deleted
  1. ;^XTMP("VPRPX", "DOC", ien) = NOW ^ id [^ visit ^ @/1, if amended]
  1. ;^XTMP("VPRPX", "DOC", ien, 0) = BEFORE 0-node, if deleted
  1. ;^XTMP("VPRPX", "AVST"/"ADOC", NOW, ien) = ""
  1. ;
  1. ; where:
  1. ; NOW = time last modified
  1. ; ID = record id as 'ien;file#'
  1. ; NEW = 1 if new during session
  1. ; VTYP = 1 if visit type in V CPT was deleted (else null)
  1. ;
  1. PX ; -- PXK VISIT DATA EVENT protocol listener
  1. Q:'$P($G(^VPR(1,0)),U,2) ;monitoring disabled
  1. N VST,PX0A,PX0B,DFN,VSTX,VPRPX,X,NOW,NEW,ID,SUB,DA,ACT,VTYP
  1. S VST=+$O(^TMP("PXKCO",$J,0)) Q:VST<1
  1. S PX0A=$G(^TMP("PXKCO",$J,VST,"VST",VST,0,"AFTER")),PX0B=$G(^("BEFORE"))
  1. S DFN=$S($L(PX0A):+$P(PX0A,U,5),1:+$P(PX0B,U,5)) Q:DFN<1
  1. S VSTX=VST_"~"_DFN ;visit id for XTMP
  1. ;
  1. ; get or set up ^XTMP
  1. S VPRPX=$NA(^XTMP("VPRPX"))
  1. L +@VPRPX@(VSTX):5 ;I'$T
  1. ;
  1. ; Visit file
  1. S X=$G(@VPRPX@(VSTX)),NOW=+X,ID=$P(X,U,2),NEW=$P(X,U,3),VTYP=$P(X,U,4)
  1. K:NOW @VPRPX@("AVST",NOW,VSTX) ;reset clock
  1. I ID="" S ID=VST_";9000010"
  1. S NOW=$$NOW^XLFDT,@VPRPX@("AVST",NOW,VSTX)=""
  1. S:PX0B="" NEW=1
  1. S @VPRPX@(VSTX)=NOW_U_ID_U_NEW_U_VTYP
  1. ;
  1. ; V-files
  1. F SUB="IMM","ICR","XAM","POV","HF","CPT" D ;"PED","SK"
  1. . S DA=0 F S DA=$O(^TMP("PXKCO",$J,VST,SUB,DA)) Q:DA<1 D
  1. .. S ACT=$$DIFF(SUB,DA) Q:'ACT ;not changed
  1. .. I SUB="HF" Q:$$NAME(SUB,DA)="" ;not Hx
  1. .. I SUB="CPT" D Q:$$DUP(DA) ;duplicate code
  1. ... Q:$P($G(^TMP("PXKCO",$J,VST,SUB,DA,0,"BEFORE")),U)'?1"992"2N
  1. ... S:ACT<1 $P(@VPRPX@(VSTX),U,4)=1 ;visit type deleted
  1. .. S NEW=$G(@VPRPX@(VSTX,SUB,DA)) S:ACT=2 NEW=1
  1. .. S @VPRPX@(VSTX,SUB,DA)=NEW ;new flag
  1. .. S X=$G(^TMP("PXKCO",$J,VST,SUB,DA,0,"AFTER")) S:'X X=$G(^("BEFORE"))
  1. .. S:$L(X) @VPRPX@(VSTX,SUB,DA,0)=X
  1. PXQ ; done
  1. L -@VPRPX@(VSTX)
  1. I '$G(@VPRPX@("ZTSK")) D NEWTSK
  1. Q
  1. ;
  1. DIFF(NM,IEN) ; -- returns 0/1 if un/changed, 2 if new, -1 if deleted
  1. N NODE,AFTER,BEFORE,DIFF
  1. S DIFF=0 F NODE=0,12,13,811 D Q:DIFF
  1. . S AFTER=$G(^TMP("PXKCO",$J,VST,NM,IEN,NODE,"AFTER")),BEFORE=$G(^("BEFORE"))
  1. . Q:BEFORE=AFTER S DIFF=1
  1. . S:(NODE=0)&(BEFORE="") DIFF=2 ;new
  1. . S:(NODE=0)&(AFTER="") DIFF=-1 ;deleted
  1. Q DIFF
  1. ;
  1. EDP(IEN) ; -- EDP Log file #230 AVPR index
  1. Q:'$P($G(^VPR(1,0)),U,2) ;monitoring disabled
  1. N EDP0,VST,DFN,VSTX,VPRPX,X,NOW,ID,NEW
  1. S IEN=+$G(IEN) Q:IEN<1
  1. S EDP0=$G(^EDP(230,IEN,0)),VST=+$P(EDP0,U,12) Q:VST<1
  1. S DFN=+$P(EDP0,U,6) Q:DFN<1
  1. ; non-PCE event so post immediately for BMS
  1. D POST^VPRHS(DFN,"Encounter",VST_";9000010")
  1. Q
  1. ; get or set up ^XTMP [old]
  1. S VSTX=VST_"~"_DFN ;visit id for XTMP
  1. S VPRPX=$NA(^XTMP("VPRPX"))
  1. L +@VPRPX@(VSTX):5 ;I'$T
  1. ;
  1. ; Visit file
  1. S X=$G(@VPRPX@(VSTX)),NOW=+X,ID=$P(X,U,2),NEW=$P(X,U,3)
  1. K:NOW @VPRPX@("AVST",NOW,VSTX) ;reset clock
  1. I ID="" S ID=VST_";9000010"
  1. S NOW=$$NOW^XLFDT,@VPRPX@("AVST",NOW,VSTX)=""
  1. S @VPRPX@(VSTX)=NOW_U_ID_U_NEW
  1. ;
  1. L -@VPRPX@(VSTX)
  1. I '$G(@VPRPX@("ZTSK")) D NEWTSK
  1. Q
  1. ;
  1. TIU(IEN,ACT,VST) ; -- TIU Document file #8925 [from TIU/R^VPREVNT]
  1. ; add to ^XTMP("VPRPX") list w/encounters
  1. N VPRPX,X0,NOW,NEW
  1. S VPRPX=$NA(^XTMP("VPRPX")),IEN=+$G(IEN)
  1. L +@VPRPX@("DOC",IEN):5 ;I'$T
  1. ;
  1. S X0=$G(@VPRPX@("DOC",IEN)),NOW=+X0 K:NOW @VPRPX@("ADOC",NOW,IEN)
  1. S VST=$G(VST,$P(X0,U,3)),NEW=$P(X0,U,4) ;VST passed in if retracted
  1. ; ACT=1 for new amendment, if aborted (@) kill XTMP and quit
  1. I NEW,$G(ACT)="@" K @VPRPX@("DOC",IEN) L -@VPRPX@("DOC",IEN) Q
  1. ;
  1. S NOW=$$NOW^XLFDT,@VPRPX@("ADOC",NOW,IEN)="" S:$L($G(ACT)) NEW=ACT
  1. S @VPRPX@("DOC",IEN)=NOW_U_IEN_";8925"_U_VST_U_NEW
  1. S:NEW="@" @VPRPX@("DOC",IEN,0)=$$NODE("TIU(8925,",IEN,0)
  1. L -@VPRPX@("DOC",IEN)
  1. I '$G(@VPRPX@("ZTSK")) D NEWTSK
  1. Q
  1. ;
  1. NEWTSK ; -- start new task
  1. L +^XTMP("VPRPX","ZTSK"):3 Q:'$T ;will try again
  1. ; if no competing process got there first, create task
  1. I '$G(^XTMP("VPRPX","ZTSK")) D QUE(5)
  1. L -^XTMP("VPRPX","ZTSK")
  1. Q
  1. ;
  1. QUE(M) ; -- create task to post encounters, documents to HS
  1. N ZTRTN,ZTDTH,ZTDESC,ZTIO,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC,ZTSK
  1. S ZTRTN="TASK^VPRENC",ZTDESC="VPR Encounters",ZTIO=""
  1. S M=+$G(M,5),ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,,,M)
  1. D ^%ZTLOAD
  1. S ^XTMP("VPRPX","ZTSK")=$G(ZTSK)
  1. S ^XTMP("VPRPX",0)=$$FMADD^XLFDT(DT,2)_U_DT_"^Encounters for HealthShare"
  1. Q
  1. ;
  1. TASK ; -- post an encounter update
  1. S ZTREQ="@" Q:'$P($G(^VPR(1,0)),U,2) ;monitoring disabled
  1. N VPRPX,VPRDT,VPRI,VSTX,VST,X0,DFN,V0,VNM,VFL,VDA,VID,ACT,X,VPRD14,VPRSQ
  1. S VPRPX=$NA(^XTMP("VPRPX")),VPRDT=$$FMADD^XLFDT($$NOW^XLFDT,,,-2)
  1. S VPRD14=$$FMADD^XLFDT(DT,14)
  1. ; post visits that have been stable for at least 5 minutes
  1. S VPRI=0 F S VPRI=$O(@VPRPX@("AVST",VPRI)) Q:VPRI<1 Q:VPRI>VPRDT D
  1. . S VSTX="" F S VSTX=$O(@VPRPX@("AVST",VPRI,VSTX)) Q:VSTX="" D
  1. .. I '$D(@VPRPX@(VSTX)) K @VPRPX@("AVST",VPRI,VSTX) Q
  1. .. L +@VPRPX@(VSTX):5 Q:'$T ;will requeue
  1. .. S X0=$G(@VPRPX@(VSTX)),VST=+VSTX,DFN=+$P(VSTX,"~",2)
  1. .. S V0=$G(^AUPNVSIT(VST,0))
  1. .. I V0=""!($P(V0,U,5)'=DFN) D Q ;deleted or replaced:
  1. ... I $P(X0,U,3) D KILL Q ; not in HS, just kill XTMP
  1. ... D DELALL ; else send delete to HS
  1. .. ; post Encounter to HS
  1. .. S VID=$P(X0,U,2) S:VID="" VID=VST_";9000010"
  1. .. K VPRSQ D POST^VPRHS(DFN,"Encounter",VID,,,.VPRSQ)
  1. .. I $G(VPRSQ),$P(X0,U,4) D SAVST(VPRSQ,"U",1) ;VType deleted
  1. TV .. ; post related v-file records next
  1. .. S VFL="" F S VFL=$O(@VPRPX@(VSTX,VFL)) Q:VFL="" D
  1. ... S VDA=0 F S VDA=$O(@VPRPX@(VSTX,VFL,VDA)) Q:VDA<1 D
  1. .... S VNM=$$NAME(VFL,VDA) Q:VNM="" ;not tracked
  1. .... S V0=$$ZERO(VFL,VDA),VID=VDA_";"_$P(VNM,U,2)
  1. .... ; if exists & is valid send to HS, else quit/delete
  1. .... I V0,$P(V0,U,2)=DFN,$P(V0,U,3)=VST D POST^VPRHS(DFN,$P(VNM,U),VID,,VST) Q
  1. .... Q:$G(@VPRPX@(VSTX,VFL,VDA)) ;new, backed out (don't send)
  1. .... K VPRSQ ;S VID=VDA_"~"_VST_";"_$P(VNM,U,2)
  1. .... D POST^VPRHS(DFN,$P(VNM,U),VID,"@",VST,.VPRSQ)
  1. .... I $G(VPRSQ) D SAVE(VPRSQ,VDA)
  1. .. D KILL ;delete XTMP, unlock
  1. .. ; post related documents
  1. .. S VDA=0 F S VDA=$O(^TIU(8925,"V",+VST,VDA)) Q:VDA<1 I $G(@VPRPX@("DOC",VDA)) D DOC
  1. TD ; look for waiting documents w/o visit [yet]
  1. S VPRI=0 F S VPRI=$O(@VPRPX@("ADOC",VPRI)) Q:VPRI<1 Q:VPRI>VPRDT D
  1. . S VDA=0 F S VDA=$O(@VPRPX@("ADOC",VPRI,VDA)) Q:VDA<1 D
  1. .. I '$G(@VPRPX@("DOC",VDA)) K @VPRPX@("ADOC",VPRI,VDA) Q ;bad xref
  1. .. D DOC
  1. TQ ; re-task if more data
  1. S X=$O(@VPRPX@(0)) I $L(X),X'="ZTSK" D QUE(5) Q
  1. K @VPRPX@("ZTSK")
  1. Q
  1. ;
  1. DELALL ; -- delete visit + vfiles from HS [from TASK]
  1. S VFL="" F S VFL=$O(@VPRPX@(VSTX,VFL)) Q:VFL="" D
  1. . S VDA=0 F S VDA=$O(@VPRPX@(VSTX,VFL,VDA)) Q:VDA<1 D
  1. .. S VNM=$$NAME(VFL,VDA) I VNM="" Q ;not tracked in HS
  1. .. I $G(@VPRPX@(VSTX,VFL,VDA)) Q ;never sent to HS
  1. .. K VPRSQ S VID=VDA_";"_$P(VNM,U,2) ;_"~"_VST
  1. .. D POST^VPRHS(DFN,$P(VNM,U),VID,"@",VST,.VPRSQ)
  1. .. I $G(VPRSQ) D SAVE(VPRSQ,VDA)
  1. K VPRSQ D POST^VPRHS(DFN,"Encounter",VST_";9000010","@",,.VPRSQ)
  1. I $G(VPRSQ) D SAVST(VPRSQ)
  1. KILL ; clean up ^XTMP
  1. K @VPRPX@(VSTX),@VPRPX@("AVST",VPRI,VSTX)
  1. L -@VPRPX@(VSTX)
  1. Q
  1. ;
  1. SAVE(NUM,DA) ; -- save data for V-file record [from TV,DELALL] in
  1. ; ^XTMP("VPR-"_NUM, 0) = DT+14 ^ DT ^ Deleted records
  1. ; ^XTMP("VPR-"_NUM,DA) = DFN ^ TYPE ^ ID ^ U/D ^ VISIT#
  1. ; ^XTMP("VPR-"_NUM,DA,0) = DATA
  1. Q:'$G(NUM) Q:'$G(DA)
  1. S:'$G(VPRD14) VPRD14=$$FMADD^XLFDT(DT,14)
  1. S ^XTMP("VPR-"_NUM,0)=VPRD14_U_DT_"^Deleted record for AVPR"
  1. S ^XTMP("VPR-"_NUM,DA)=DFN_U_$P(VNM,U)_U_VID_"^D^"_VST
  1. S X=$G(@VPRPX@(VSTX,VFL,DA,0)) S:$L(X) ^XTMP("VPR-"_NUM,DA,0)=X
  1. Q
  1. SAVST(NUM,ACT,TYP) ; -- save visit in ^XTMP [from TASK,DELALL]
  1. Q:'$G(NUM) Q:'$G(VST) S ACT=$G(ACT,"D")
  1. S:'$G(VPRD14) VPRD14=$$FMADD^XLFDT(DT,14)
  1. S ^XTMP("VPR-"_NUM,0)=VPRD14_U_DT_"^Deleted visit for AVPR"
  1. S ^XTMP("VPR-"_NUM,VST)=DFN_"^Encounter^"_VST_";9000010^"_ACT_U_U_$G(TYP)
  1. Q
  1. ;
  1. DOC ; -- process Document VDA [from TASK]
  1. L +@VPRPX@("DOC",VDA):5 Q:'$T ;will requeue
  1. N VPRTIU,STS,ACT,CLS,VPRSQ
  1. S X0=$G(@VPRPX@("DOC",VDA)) D EXTRACT(VDA)
  1. S VST=$G(VPRTIU(.03)),DFN=$G(VPRTIU(.02))
  1. ; quit if has visit, still in ^XTMP (send w/visit)
  1. I VST,$G(@VPRPX@(VST_"~"_DFN)) L -@VPRPX@("DOC",VDA) Q
  1. ; else post to HS
  1. S VID=$P(X0,U,2) I VID="" S VID=VDA_";8925"
  1. S STS=$G(VPRTIU(.05)),ACT=$S($P(X0,U,4)="@":"@",STS>13:"@",1:"")
  1. I ACT="@",'VST S VST=$P(X0,U,3) ;amended
  1. D POST^VPRHS(DFN,"Document",VID,ACT,VST,.VPRSQ)
  1. I ACT="@",$G(VPRSQ) D ;save to preserve visit#
  1. . S ^XTMP("VPR-"_VPRSQ,VDA)=DFN_"^Document^"_VID_"^D^"_VST
  1. . S X=+$G(VPRTIU(.01)),^XTMP("VPR-"_VPRSQ,VDA,0)=X_U_DFN_U_VST
  1. . S ^XTMP("VPR-"_VPRSQ,0)=$$FMADD^XLFDT(DT,14)_U_DT_"^Deleted record for AVPR"
  1. ; update alert containers if CLS is CWD
  1. S CLS=$G(VPRTIU(.04))
  1. D:CLS=27 POST^VPRHS(DFN,"AdvanceDirective",VID,ACT)
  1. D:CLS=30!(CLS=31) POST^VPRHS(DFN,"Alert",VID,ACT)
  1. DQ ; clean up array, unlock
  1. K @VPRPX@("DOC",VDA),@VPRPX@("ADOC",+X0,VDA)
  1. L -@VPRPX@("DOC",VDA)
  1. ;
  1. I VST D ;add/update Surgery when report completed
  1. . N PROC S PROC=$G(VPRTIU(1405)) Q:'PROC
  1. . I PROC["SRF" D POST^VPRHS(DFN,"Procedure",+PROC_";130",,VST) Q
  1. Q
  1. ;
  1. EXTRACT(DA) ; -- return data in VPRTIU(FLD)
  1. N I,DR,DIC,DIQ,VPRQ Q:'$G(DA)
  1. I $P(X0,U,4)="@" D Q
  1. . N X1 S X1=$G(@VPRPX@("DOC",VDA,0))
  1. . F I=1:1:5 S VPRTIU(".0"_I)=$P(X1,U,I)
  1. S DIC=8925,DIQ="VPRQ",DIQ(0)="I",DR=".01:.05;1405" D EN^DIQ1
  1. F I=.01,.02,.03,.04,.05,1405 S VPRTIU(I)=$G(VPRQ(8925,DA,I,"I"))
  1. Q
  1. ;
  1. NAME(X,DA) ; -- return container name for V-files
  1. N Y S Y=""
  1. I X="HF" D
  1. . N NM S DA=+$G(DA),NM=$P($G(^AUTTHF($$HF(DA),0)),U)
  1. . I $$FHX(NM) S Y="FamilyHistory^9000010.23" Q
  1. . I $$SHX(NM) S Y="SocialHistory^9000010.23" Q
  1. . I $$C19(NM) S Y="Vaccination^9000010.23" Q
  1. . ;S Y="HealthConcern^9000010.23"
  1. I X="IMM" S Y="Vaccination^9000010.11"
  1. I X="ICR" S Y="Vaccination^9000010.707"
  1. I X="XAM" S Y="PhysicalExam^9000010.13"
  1. I X="POV" S Y="Diagnosis^9000010.07"
  1. I X="CPT" S Y="Procedure^9000010.18"
  1. ; X="SK" S Y="Procedure^9000010.12"
  1. ; X="PED" S Y="education^9000010.16"
  1. I X="DOC" S Y="Document^8925"
  1. Q Y
  1. ;
  1. HF(IEN) ; -- return AUTTHF ptr, expects VST & VSTX
  1. N X S IEN=+$G(IEN)
  1. I $G(VST),$D(^TMP("PXKCO",$J,VST)) D Q +X
  1. . S X=$G(^TMP("PXKCO",$J,VST,"HF",IEN,0,"BEFORE")) S:'X X=$G(^("AFTER"))
  1. I $D(VPRPX),$G(VSTX) S X=$G(@VPRPX@(VSTX,"HF",IEN,0)) I X Q +X
  1. S X=$$ZERO("HF",IEN) I X Q +X
  1. Q 0
  1. ;
  1. FHX(X) ; -- return 1 or 0, if HF name is for FamilyHistory
  1. I X["FAMILY HISTORY" Q 1
  1. I X["FAMILY HX" Q 1
  1. Q 0
  1. ;
  1. SHX(X) ; -- return 1 or 0, if HF name is for SocialHistory
  1. I (X["TOBACCO")!(X["SMOK") Q 1
  1. ; (X["LIVES")!(X["LIVING") Q 1
  1. ; (X["RELIGIO")!(X["SPIRIT") Q 1
  1. Q 0
  1. ;
  1. C19(X) ; -- return 1 or 0, if HF name is for COVID imm refusal
  1. I X?1"VA-SARS-COV-2 VACCINE REFUSAL".E Q 1
  1. I X?1"VA-SARS-COV-2 IMM REFUSAL".E Q 1
  1. Q 0
  1. ;
  1. ZERO(X,DA) ; -- return zero node
  1. N GBL,Y S Y="",DA=+$G(DA)
  1. S GBL="^AUPNV"_$G(X),Y=$G(@GBL@(DA,0))
  1. Q Y
  1. ;
  1. NODE(NAME,DA,NUM) ; -- return global node
  1. N GBL,Y S Y="",DA=+$G(DA)
  1. S GBL=U_NAME_DA_")"
  1. S Y=$G(@GBL@(NUM))
  1. Q Y
  1. ;
  1. DUP(DA) ; -- duplicate CPT record?
  1. N VCPT,NODE,CPT,PKG,Y,IEN,GBL,IMM,SYS
  1. M VCPT=^TMP("PXKCO",$J,VST,SUB,DA)
  1. S NODE=$S($G(VCPT(0,"AFTER")):"AFTER",1:"BEFORE")
  1. ; skip eval/mgt codes
  1. S CPT=$P($G(VCPT(0,NODE)),U) I CPT>99200,CPT<99500 Q 1
  1. ; skip Surgery (duplicates)
  1. S PKG=+$P($G(VCPT(812,NODE)),U,2) I PKG,$P($G(^DIC(9.4,PKG,0)),U,2)="SR" Q 1
  1. ; skip V IMMUNIZATIONS codes
  1. S GBL="^AUTTIMM",(Y,IEN)=0
  1. F S IEN=$O(^TMP("PXKCO",$J,VST,"IMM",IEN)) Q:IEN<1 D Q:Y
  1. . S NODE=$S($G(^TMP("PXKCO",$J,VST,"IMM",IEN,0,"AFTER")):"AFTER",1:"BEFORE")
  1. . S IMM=+$G(^TMP("PXKCO",$J,VST,"IMM",IEN,0,NODE))
  1. . S SYS=+$O(@GBL@(IMM,3,"B","CPT",0))
  1. . S:SYS Y=+$O(@GBL@(IMM,3,SYS,1,"B",CPT,0))
  1. I Y Q 1
  1. ; else ok/not dup
  1. Q 0