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