TIUPXAP1 ;SLC/JER - Interface w/PCE/Visit Tracking ;Nov 09, 2018@09:27
;;1.0;TEXT INTEGRATION UTILITIES;**15,29,20,89,82,107,117,126,124,149,179,205,295,314,289**;Jun 20, 1997;Build 200
;Per VHA Directive 2004-038, this routine should not be modified
QUE ; Post visit tracking information
; if there is already a visit, and no workload data quit
; *295 Skip defer logic if from reassign (TIURD3)
; *314 move check for call from TIURD3 to the Quit condition
I +$P($G(TIUDPRM(0)),U,16),(+$P($G(^TIU(8925,$S(+$G(TIUDA):+$G(TIUDA),1:+$G(DA)),0)),U,11)=0),+$$WORKOK($S(+$G(TIUDA):+$G(TIUDA),1:+$G(DA))) D Q:'$$BROKER^XWBLIB&('$G(TIUREASS))
. D DEFER($S(+$G(TIUDA):+$G(TIUDA),1:+$G(DA)))
I +$G(TIU("VISIT")),($D(CPT)'>9) Q
I +$P($G(^TIU(8925,$S(+$G(TIUDA):+$G(TIUDA),1:+$G(DA)),0)),U,3),($D(CPT)'>9) Q
D ENQ
Q
WORKOK(DA) ; Evaluate whether workload collection is appropriate
N TIUD0 S TIUD0=$G(^TIU(8925,DA,0))
Q $S($P(TIUD0,U,13)="A":1,$P(TIUD0,U,13)="I":1,$P(TIUD0,U,13)="T":1,1:0)
ENQ ; Entry point for Resource
I $D(ZTQUEUED) S ZTREQ="@"
D POST(.TIU,DFN,$S(+$G(TIUDA):+$G(TIUDA),1:$G(DA)),.ICD,.CPT,.SC)
Q
POST(TIUX,DFN,TIUDA,ICD,CPT,SC) ; Call on commitment to post data to PCE/AmbCare
N TIULOC,TIUVDT,TIUSTOP,TIUVCAT,TIUVSIT,TIUD0
S TIULOC=$P($G(TIUX("VSTR")),";"),TIUVDT=+$P($G(TIUX("VSTR")),";",2)
S TIUVCAT=$P($G(TIUX("VSTR")),";",3),TIUSTOP=$P($G(^SC(+TIULOC,0)),U,7)
D PXAPI(.TIUVSIT,DFN,TIULOC,TIUVDT,TIUVCAT,TIUSTOP,.ICD,.CPT,.SC,TIUDA)
I +$G(TIUVSIT)>0,+$G(TIUDA)>0,$D(^TIU(8925,+TIUDA,0)) S TIUD0=^(0) D
. I $P(TIUD0,U,2)=DFN,$P(TIUD0,U,7)=TIUVDT,$P($G(^TIU(8925,+TIUDA,12)),U,11)=TIULOC D
. . N DIE,DR,DA S DA=+$G(TIUDA)
. . S DIE=8925,DR=".03////^S X="_+$G(TIUVSIT)
. . D ^DIE
. . S TIUX("VISIT")=+$G(TIUVSIT)_U_TIUVDT
Q
PXAPI(TIUVSIT,DFN,VLOC,VDT,VCAT,VSTOP,ICD,CPT,SC,TIUDA) ; Build input root
N TIUPXAPI,SUCCESS,TIUI,TIUPROV,DA,TIUAUTH
K ^TMP("TIUPXAPI",$J) S TIUPXAPI=$NA(^TMP("TIUPXAPI",$J))
S:+$G(VDT) @TIUPXAPI@("ENCOUNTER",1,"ENC D/T")=+$G(VDT)
S:+$G(DFN) @TIUPXAPI@("ENCOUNTER",1,"PATIENT")=+$G(DFN)
S:+$G(VLOC) @TIUPXAPI@("ENCOUNTER",1,"HOS LOC")=+$G(VLOC)
I $D(SC)>9 D
. S @TIUPXAPI@("ENCOUNTER",1,"SC")=$P($G(SC("SC")),U)
. I $G(SC("AO"))]"" S @TIUPXAPI@("ENCOUNTER",1,"AO")=$P($G(SC("AO")),U)
. I $G(SC("IR"))]"" S @TIUPXAPI@("ENCOUNTER",1,"IR")=$P($G(SC("IR")),U)
. I $G(SC("EC"))]"" S @TIUPXAPI@("ENCOUNTER",1,"EC")=$P($G(SC("EC")),U)
. I $G(SC("MST"))]"" S @TIUPXAPI@("ENCOUNTER",1,"MST")=$P($G(SC("MST")),U)
. I $G(SC("HNC"))]"" S @TIUPXAPI@("ENCOUNTER",1,"HNC")=$P($G(SC("HNC")),U)
I $D(CPT) S @TIUPXAPI@("ENCOUNTER",1,"CHECKOUT D/T")=$E($$NOW^XLFDT,1,12)
S:$G(VCAT)]"" @TIUPXAPI@("ENCOUNTER",1,"SERVICE CATEGORY")=$G(VCAT)
S:+$G(VSTOP) @TIUPXAPI@("ENCOUNTER",1,"DSS ID")=+$G(VSTOP)
S @TIUPXAPI@("ENCOUNTER",1,"APPT")=9
S @TIUPXAPI@("ENCOUNTER",1,"ENCOUNTER TYPE")="P"
I $D(TIUPRLST) D
. M @TIUPXAPI@("PROVIDER")=TIUPRLST
. S TIUPROV=$S($G(TIUPRLST(1,"PRIMARY")):$G(TIUPRLST(1,"NAME")),1:$G(TIUPRLST(2,"NAME")))
E D
. N TIUDDOC
. I +$G(TIUDA) D
. . S TIUAUTH=$P($G(^TIU(8925,+$G(TIUDA),12)),U,2) Q:+TIUAUTH'>0
. . I +$$PROVIDER(TIUAUTH,$G(VDT))'>0 S TIUAUTH=0
. S TIUDDOC=+$$DFLTDOC^TIUPXAPI(+$G(VLOC))
. D:'$D(TIUPRM0) SETPARM^TIULE
. S TIUPROV=$S(+$G(TIUAUTH):+$G(TIUAUTH),+$$PROVIDER(DUZ,$G(VDT)):+$G(DUZ),1:"")
. I +TIUPROV>0,'$D(XWBOS) D
. . I +TIUDDOC'=+TIUPROV,(+$P(TIUPRM0,U,8)=1),+TIUDDOC>0 D
. . . ; Get Provider information from Encounter.
. . . ; If ENC has no provicders then add default provider as primary.
. . . ; Add TIUPROV unless already primary provider for encounter.
. . . N TIUPRIME,TIUPVCNT,TIUTVST,TIUTPRV,TIUPDATA
. . . S TIUPRIME="",TIUPVCNT=1
. . . D GETENC^PXAPI($G(DFN),$G(VDT),$G(VLOC))
. . . S TIUTVST=""
. . . F S TIUTVST=$O(^TMP("PXKENC",$J,TIUTVST)) Q:TIUTVST="" D
. . . . S TIUTPRV=""
. . . . F S TIUTPRV=$O(^TMP("PXKENC",$J,TIUTVST,"PRV",TIUTPRV)) Q:TIUTPRV="" D
. . . . . S TIUPDATA=$G(^TMP("PXKENC",$J,TIUTVST,"PRV",TIUTPRV,0))
. . . . . I $P(TIUPDATA,"^",4)="P" S TIUPRIME=+TIUPDATA
. . . I 'TIUPRIME D
. . . . S @TIUPXAPI@("PROVIDER",TIUPVCNT,"NAME")=+TIUDDOC
. . . . S @TIUPXAPI@("PROVIDER",TIUPVCNT,"PRIMARY")=1
. . . . S TIUPVCNT=TIUPVCNT+1
. . . S @TIUPXAPI@("PROVIDER",TIUPVCNT,"NAME")=+TIUPROV
. . E D
. . . S @TIUPXAPI@("PROVIDER",1,"NAME")=+TIUPROV
I $D(ICD)>9 S TIUI=0 F S TIUI=$O(ICD(TIUI)) Q:+TIUI'>0 D
. S @TIUPXAPI@("DX/PL",TIUI,"ENC PROVIDER")=$G(TIUPROV)
. S @TIUPXAPI@("DX/PL",TIUI,"DIAGNOSIS")=$P(ICD(TIUI),U)
. S @TIUPXAPI@("DX/PL",TIUI,"NARRATIVE")=$P(ICD(TIUI),U,3)
. S:$P(ICD(TIUI),U,4)]"" @TIUPXAPI@("DX/PL",TIUI,"CATEGORY")=$P(ICD(TIUI),U,4)
. S:+$G(ICD(TIUI,"PRIMARY")) @TIUPXAPI@("DX/PL",TIUI,"PRIMARY")=$G(ICD(TIUI,"PRIMARY"))
I $D(CPT)>9 S TIUI=0 F S TIUI=$O(CPT(TIUI)) Q:+TIUI'>0 D
. S @TIUPXAPI@("PROCEDURE",TIUI,"PROCEDURE")=$P(CPT(TIUI),U)
. S @TIUPXAPI@("PROCEDURE",TIUI,"QTY")=$S(+$G(CPT(TIUI,"QTY")):+$G(CPT(TIUI,"QTY")),1:1)
. ;Set CPT Modifiers in Array for PCE
. N MODCNT,MODATA
. S MODCNT=0
. F S MODCNT=$O(CPT(TIUI,"MOD",MODCNT)) Q:'MODCNT D
. . S MODATA=$G(CPT(TIUI,"MOD",MODCNT))
. . S:$P(MODATA,U,2)'="" @TIUPXAPI@("PROCEDURE",TIUI,"MODIFIERS",$P(MODATA,U,2))=""
. S @TIUPXAPI@("PROCEDURE",TIUI,"ENC PROVIDER")=$G(TIUPROV)
. S @TIUPXAPI@("PROCEDURE",TIUI,"NARRATIVE")=$P(CPT(TIUI),U,2)
. S:$P(CPT(TIUI),U,3)]"" @TIUPXAPI@("PROCEDURE",TIUI,"CATEGORY")=$P(CPT(TIUI),U,3)
S SUCCESS=$$DATA2PCE^PXAPI(TIUPXAPI,"TIU","TEXT INTEGRATION UTILITIES",.TIUVSIT,DUZ,0)
K @TIUPXAPI
Q
PROVIDER(USER,DATE) ; Was USER a PROVIDER on DATE?
N TIUY,PRVCL,EXCL S TIUY=0
S EXCL="V0802V0805V0806V0808V0809V0812V0813"
I +$$ISA^USRLM(USER,"PROVIDER") S TIUY=1 G PROVIDEX
S PRVCL=$$PRVCLASS^PXAPI(USER,DATE) I PRVCL'>0 G PROVIDEX
I $P(PRVCL,U,7)]"",(EXCL'[$E($P(PRVCL,U,7),1,5)) S TIUY=1
PROVIDEX Q TIUY
DEFER(DA) ; Mark record to defer workload collection
N DIE,DR,TIUVSIT
I +$P($G(^TIU(8925,$S(+$G(TIUDA):+$G(TIUDA),1:+$G(DA)),0)),U,11)=1 Q
S DIE=8925,DR=".11////1" D ^DIE
;If not called via the broker try to link document to an existing visit
I '$$BROKER^XWBLIB,$$LNKVST^TIUPXAP3(+DA,.TIUVSIT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPXAP1 6224 printed Apr 09, 2024@21:44:12 Page 2
TIUPXAP1 ;SLC/JER - Interface w/PCE/Visit Tracking ;Nov 09, 2018@09:27
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**15,29,20,89,82,107,117,126,124,149,179,205,295,314,289**;Jun 20, 1997;Build 200
+2 ;Per VHA Directive 2004-038, this routine should not be modified
QUE ; Post visit tracking information
+1 ; if there is already a visit, and no workload data quit
+2 ; *295 Skip defer logic if from reassign (TIURD3)
+3 ; *314 move check for call from TIURD3 to the Quit condition
+4 IF +$PIECE($GET(TIUDPRM(0)),U,16)
IF (+$PIECE($GET(^TIU(8925,$SELECT(+$GET(TIUDA):+$GET(TIUDA),1:+$GET(DA)),0)),U,11)=0)
IF +$$WORKOK($SELECT(+$GET(TIUDA):+$GET(TIUDA),1:+$GET(DA)))
Begin DoDot:1
+5 DO DEFER($SELECT(+$GET(TIUDA):+$GET(TIUDA),1:+$GET(DA)))
End DoDot:1
if '$$BROKER^XWBLIB&('$GET(TIUREASS))
QUIT
+6 IF +$GET(TIU("VISIT"))
IF ($DATA(CPT)'>9)
QUIT
+7 IF +$PIECE($GET(^TIU(8925,$SELECT(+$GET(TIUDA):+$GET(TIUDA),1:+$GET(DA)),0)),U,3)
IF ($DATA(CPT)'>9)
QUIT
+8 DO ENQ
+9 QUIT
WORKOK(DA) ; Evaluate whether workload collection is appropriate
+1 NEW TIUD0
SET TIUD0=$GET(^TIU(8925,DA,0))
+2 QUIT $SELECT($PIECE(TIUD0,U,13)="A":1,$PIECE(TIUD0,U,13)="I":1,$PIECE(TIUD0,U,13)="T":1,1:0)
ENQ ; Entry point for Resource
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 DO POST(.TIU,DFN,$SELECT(+$GET(TIUDA):+$GET(TIUDA),1:$GET(DA)),.ICD,.CPT,.SC)
+3 QUIT
POST(TIUX,DFN,TIUDA,ICD,CPT,SC) ; Call on commitment to post data to PCE/AmbCare
+1 NEW TIULOC,TIUVDT,TIUSTOP,TIUVCAT,TIUVSIT,TIUD0
+2 SET TIULOC=$PIECE($GET(TIUX("VSTR")),";")
SET TIUVDT=+$PIECE($GET(TIUX("VSTR")),";",2)
+3 SET TIUVCAT=$PIECE($GET(TIUX("VSTR")),";",3)
SET TIUSTOP=$PIECE($GET(^SC(+TIULOC,0)),U,7)
+4 DO PXAPI(.TIUVSIT,DFN,TIULOC,TIUVDT,TIUVCAT,TIUSTOP,.ICD,.CPT,.SC,TIUDA)
+5 IF +$GET(TIUVSIT)>0
IF +$GET(TIUDA)>0
IF $DATA(^TIU(8925,+TIUDA,0))
SET TIUD0=^(0)
Begin DoDot:1
+6 IF $PIECE(TIUD0,U,2)=DFN
IF $PIECE(TIUD0,U,7)=TIUVDT
IF $PIECE($GET(^TIU(8925,+TIUDA,12)),U,11)=TIULOC
Begin DoDot:2
+7 NEW DIE,DR,DA
SET DA=+$GET(TIUDA)
+8 SET DIE=8925
SET DR=".03////^S X="_+$GET(TIUVSIT)
+9 DO ^DIE
+10 SET TIUX("VISIT")=+$GET(TIUVSIT)_U_TIUVDT
End DoDot:2
End DoDot:1
+11 QUIT
PXAPI(TIUVSIT,DFN,VLOC,VDT,VCAT,VSTOP,ICD,CPT,SC,TIUDA) ; Build input root
+1 NEW TIUPXAPI,SUCCESS,TIUI,TIUPROV,DA,TIUAUTH
+2 KILL ^TMP("TIUPXAPI",$JOB)
SET TIUPXAPI=$NAME(^TMP("TIUPXAPI",$JOB))
+3 if +$GET(VDT)
SET @TIUPXAPI@("ENCOUNTER",1,"ENC D/T")=+$GET(VDT)
+4 if +$GET(DFN)
SET @TIUPXAPI@("ENCOUNTER",1,"PATIENT")=+$GET(DFN)
+5 if +$GET(VLOC)
SET @TIUPXAPI@("ENCOUNTER",1,"HOS LOC")=+$GET(VLOC)
+6 IF $DATA(SC)>9
Begin DoDot:1
+7 SET @TIUPXAPI@("ENCOUNTER",1,"SC")=$PIECE($GET(SC("SC")),U)
+8 IF $GET(SC("AO"))]""
SET @TIUPXAPI@("ENCOUNTER",1,"AO")=$PIECE($GET(SC("AO")),U)
+9 IF $GET(SC("IR"))]""
SET @TIUPXAPI@("ENCOUNTER",1,"IR")=$PIECE($GET(SC("IR")),U)
+10 IF $GET(SC("EC"))]""
SET @TIUPXAPI@("ENCOUNTER",1,"EC")=$PIECE($GET(SC("EC")),U)
+11 IF $GET(SC("MST"))]""
SET @TIUPXAPI@("ENCOUNTER",1,"MST")=$PIECE($GET(SC("MST")),U)
+12 IF $GET(SC("HNC"))]""
SET @TIUPXAPI@("ENCOUNTER",1,"HNC")=$PIECE($GET(SC("HNC")),U)
End DoDot:1
+13 IF $DATA(CPT)
SET @TIUPXAPI@("ENCOUNTER",1,"CHECKOUT D/T")=$EXTRACT($$NOW^XLFDT,1,12)
+14 if $GET(VCAT)]""
SET @TIUPXAPI@("ENCOUNTER",1,"SERVICE CATEGORY")=$GET(VCAT)
+15 if +$GET(VSTOP)
SET @TIUPXAPI@("ENCOUNTER",1,"DSS ID")=+$GET(VSTOP)
+16 SET @TIUPXAPI@("ENCOUNTER",1,"APPT")=9
+17 SET @TIUPXAPI@("ENCOUNTER",1,"ENCOUNTER TYPE")="P"
+18 IF $DATA(TIUPRLST)
Begin DoDot:1
+19 MERGE @TIUPXAPI@("PROVIDER")=TIUPRLST
+20 SET TIUPROV=$SELECT($GET(TIUPRLST(1,"PRIMARY")):$GET(TIUPRLST(1,"NAME")),1:$GET(TIUPRLST(2,"NAME")))
End DoDot:1
+21 IF '$TEST
Begin DoDot:1
+22 NEW TIUDDOC
+23 IF +$GET(TIUDA)
Begin DoDot:2
+24 SET TIUAUTH=$PIECE($GET(^TIU(8925,+$GET(TIUDA),12)),U,2)
if +TIUAUTH'>0
QUIT
+25 IF +$$PROVIDER(TIUAUTH,$GET(VDT))'>0
SET TIUAUTH=0
End DoDot:2
+26 SET TIUDDOC=+$$DFLTDOC^TIUPXAPI(+$GET(VLOC))
+27 if '$DATA(TIUPRM0)
DO SETPARM^TIULE
+28 SET TIUPROV=$SELECT(+$GET(TIUAUTH):+$GET(TIUAUTH),+$$PROVIDER(DUZ,$GET(VDT)):+$GET(DUZ),1:"")
+29 IF +TIUPROV>0
IF '$DATA(XWBOS)
Begin DoDot:2
+30 IF +TIUDDOC'=+TIUPROV
IF (+$PIECE(TIUPRM0,U,8)=1)
IF +TIUDDOC>0
Begin DoDot:3
+31 ; Get Provider information from Encounter.
+32 ; If ENC has no provicders then add default provider as primary.
+33 ; Add TIUPROV unless already primary provider for encounter.
+34 NEW TIUPRIME,TIUPVCNT,TIUTVST,TIUTPRV,TIUPDATA
+35 SET TIUPRIME=""
SET TIUPVCNT=1
+36 DO GETENC^PXAPI($GET(DFN),$GET(VDT),$GET(VLOC))
+37 SET TIUTVST=""
+38 FOR
SET TIUTVST=$ORDER(^TMP("PXKENC",$JOB,TIUTVST))
if TIUTVST=""
QUIT
Begin DoDot:4
+39 SET TIUTPRV=""
+40 FOR
SET TIUTPRV=$ORDER(^TMP("PXKENC",$JOB,TIUTVST,"PRV",TIUTPRV))
if TIUTPRV=""
QUIT
Begin DoDot:5
+41 SET TIUPDATA=$GET(^TMP("PXKENC",$JOB,TIUTVST,"PRV",TIUTPRV,0))
+42 IF $PIECE(TIUPDATA,"^",4)="P"
SET TIUPRIME=+TIUPDATA
End DoDot:5
End DoDot:4
+43 IF 'TIUPRIME
Begin DoDot:4
+44 SET @TIUPXAPI@("PROVIDER",TIUPVCNT,"NAME")=+TIUDDOC
+45 SET @TIUPXAPI@("PROVIDER",TIUPVCNT,"PRIMARY")=1
+46 SET TIUPVCNT=TIUPVCNT+1
End DoDot:4
+47 SET @TIUPXAPI@("PROVIDER",TIUPVCNT,"NAME")=+TIUPROV
End DoDot:3
+48 IF '$TEST
Begin DoDot:3
+49 SET @TIUPXAPI@("PROVIDER",1,"NAME")=+TIUPROV
End DoDot:3
End DoDot:2
End DoDot:1
+50 IF $DATA(ICD)>9
SET TIUI=0
FOR
SET TIUI=$ORDER(ICD(TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+51 SET @TIUPXAPI@("DX/PL",TIUI,"ENC PROVIDER")=$GET(TIUPROV)
+52 SET @TIUPXAPI@("DX/PL",TIUI,"DIAGNOSIS")=$PIECE(ICD(TIUI),U)
+53 SET @TIUPXAPI@("DX/PL",TIUI,"NARRATIVE")=$PIECE(ICD(TIUI),U,3)
+54 if $PIECE(ICD(TIUI),U,4)]""
SET @TIUPXAPI@("DX/PL",TIUI,"CATEGORY")=$PIECE(ICD(TIUI),U,4)
+55 if +$GET(ICD(TIUI,"PRIMARY"))
SET @TIUPXAPI@("DX/PL",TIUI,"PRIMARY")=$GET(ICD(TIUI,"PRIMARY"))
End DoDot:1
+56 IF $DATA(CPT)>9
SET TIUI=0
FOR
SET TIUI=$ORDER(CPT(TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+57 SET @TIUPXAPI@("PROCEDURE",TIUI,"PROCEDURE")=$PIECE(CPT(TIUI),U)
+58 SET @TIUPXAPI@("PROCEDURE",TIUI,"QTY")=$SELECT(+$GET(CPT(TIUI,"QTY")):+$GET(CPT(TIUI,"QTY")),1:1)
+59 ;Set CPT Modifiers in Array for PCE
+60 NEW MODCNT,MODATA
+61 SET MODCNT=0
+62 FOR
SET MODCNT=$ORDER(CPT(TIUI,"MOD",MODCNT))
if 'MODCNT
QUIT
Begin DoDot:2
+63 SET MODATA=$GET(CPT(TIUI,"MOD",MODCNT))
+64 if $PIECE(MODATA,U,2)'=""
SET @TIUPXAPI@("PROCEDURE",TIUI,"MODIFIERS",$PIECE(MODATA,U,2))=""
End DoDot:2
+65 SET @TIUPXAPI@("PROCEDURE",TIUI,"ENC PROVIDER")=$GET(TIUPROV)
+66 SET @TIUPXAPI@("PROCEDURE",TIUI,"NARRATIVE")=$PIECE(CPT(TIUI),U,2)
+67 if $PIECE(CPT(TIUI),U,3)]""
SET @TIUPXAPI@("PROCEDURE",TIUI,"CATEGORY")=$PIECE(CPT(TIUI),U,3)
End DoDot:1
+68 SET SUCCESS=$$DATA2PCE^PXAPI(TIUPXAPI,"TIU","TEXT INTEGRATION UTILITIES",.TIUVSIT,DUZ,0)
+69 KILL @TIUPXAPI
+70 QUIT
PROVIDER(USER,DATE) ; Was USER a PROVIDER on DATE?
+1 NEW TIUY,PRVCL,EXCL
SET TIUY=0
+2 SET EXCL="V0802V0805V0806V0808V0809V0812V0813"
+3 IF +$$ISA^USRLM(USER,"PROVIDER")
SET TIUY=1
GOTO PROVIDEX
+4 SET PRVCL=$$PRVCLASS^PXAPI(USER,DATE)
IF PRVCL'>0
GOTO PROVIDEX
+5 IF $PIECE(PRVCL,U,7)]""
IF (EXCL'[$EXTRACT($PIECE(PRVCL,U,7),1,5))
SET TIUY=1
PROVIDEX QUIT TIUY
DEFER(DA) ; Mark record to defer workload collection
+1 NEW DIE,DR,TIUVSIT
+2 IF +$PIECE($GET(^TIU(8925,$SELECT(+$GET(TIUDA):+$GET(TIUDA),1:+$GET(DA)),0)),U,11)=1
QUIT
+3 SET DIE=8925
SET DR=".11////1"
DO ^DIE
+4 ;If not called via the broker try to link document to an existing visit
+5 IF '$$BROKER^XWBLIB
IF $$LNKVST^TIUPXAP3(+DA,.TIUVSIT)
+6 QUIT
