TIUPUTCN.m

TIUPUTCN ; SLC/JER -  Uploading Consult Results ;4/18/03

 ;;1.0;TEXT INTEGRATION UTILITIES;**4,100,120,131,113**;Jun 20, 1997

 ; External References in TIUPUTCN:

 ;   DBIA 3472  $$CPPAT^GMRCCP

LOOKUP ; Lookup Method for Consults document definition

 ; Required: TIUSSN, TIUVDT,TIUCNNBR

 N DA,DFN,TIU,TIUDAD,TIUDPRM,TIUEDIT,TIUEDT,TIULDT,TIUXCRP,TIUTYPE,TIUNEW

 I $S('$D(TIUSSN):1,'$D(TIUVDT):1,$G(TIUSSN)?4N:1,$G(TIUSSN)']"":1,1:0) S Y=-1 G LOOKUPX

 I TIUSSN?3N1P2N1P4N.E S TIUSSN=$TR(TIUSSN,"-/","")

 I TIUSSN["?" S Y=-1 G LOOKUPX

 I $G(TIUCNNBR)']"" S Y=-1 G LOOKUPX

 S TIULOC=+$$ILOC(TIULOC)

 I '$D(^SC(+$G(TIULOC),0)) S Y=-1 G LOOKUPX

 S TIUINST=+$$DIVISION^TIULC1(TIULOC)

 S TIUEDT=$$IDATE^TIULC(TIUVDT),TIULDT=$$FMADD^XLFDT(TIUEDT,1)

 I +TIUEDT'>0 S Y=-1 Q

 S TIUTYPE=$$WHATITLE(TIUTITLE)

 I +TIUTYPE'>0 S Y=-1 Q

 I $P($G(^SC(+TIULOC,0)),U,3)="W" D  I 1

 . D MAIN^TIUMOVE(.TIU,.DFN,TIUSSN,TIUEDT,TIULDT,1,"LAST",0,TIULOC)

 E  D MAIN^TIUVSIT(.TIU,.DFN,TIUSSN,TIUEDT,TIULDT,"LAST",0,TIULOC)

 I $S($D(TIU)'>9:1,+$G(DFN)'>0:1,1:0) S Y=-1 G LOOKUPX

 I $P(+$G(TIU("EDT")),".")'=$P($$IDATE^TIULC(TIUVDT),".") S Y=-1 G LOOKUPX

 ; Confirm that patient from transcribed Consult Request Number matches

 ;pt from transcribed SSN:

 I '$$CPPAT^GMRCCP(TIUCNNBR,DFN) S Y=-1 G LOOKUPX ; TIU*1*131

 D DOCPRM^TIULC1(TIUTYPE,.TIUDPRM)

 S TIUTYP(1)=1_U_TIUTYPE_U_$$PNAME^TIULC1(TIUTYPE)

 S Y=$$GETRECNW^TIUEDI3(DFN,.TIU,TIUTYP(1),.TIUNEW,.TIUDPRM)

 I +Y'>0 G LOOKUPX

 ; If record is not new, is not yet released, then delete

 ;existing text to prepare for replacement:

 I +$G(TIUNEW)'>0 D

 . S TIUEDIT=$$CANEDIT(+Y)

 . I +TIUEDIT>0,$D(^TIU(8925,+Y,"TEXT")) D DELTEXT(+Y)

 . ; If already released, then make an addendum:

 . I +TIUEDIT'>0 S TIUDAD=+Y,Y=$$MAKEADD

 I +Y'>0 Q

 ; Stuff transcribed look-up data, etc.: 

 D STUFREC(Y,+$G(TIUDAD))

 I +$G(TIUDAD) D SENDADD^TIUALRT(+Y)

 ; Prevent STUFREC^TIUPUTC from overwriting unneeded fields with

 ;possibly erroneous transcribed data:

 K TIUHDR(.01),TIUHDR(.07),TIUHDR(1301)

LOOKUPX Q

ILOC(LOCATION) ; Get pointer to file 44

 N DIC,X,Y

 S DIC=44,DIC(0)="M",X=LOCATION D ^DIC

 Q Y

CANEDIT(DA) ; Check if document is not released yet

 Q $S(+$P($G(^TIU(8925,+DA,0)),U,5)<4:1,1:0) ;TIU*1*131

MAKEADD() ; Create an addendum record

 N DIE,DR,DA,DIC,X,Y,DLAYGO,TIUATYP,TIUFPRIV S TIUFPRIV=1

 ; Get 8925.1 IEN for title "ADDENDUM"; DON'T require it to be consult

 S TIUATYP=+$$WHATITLE^TIUPUTU("ADDENDUM")

 S (DIC,DLAYGO)=8925,DIC(0)="L",X=""""_"`"_TIUATYP_""""

 D ^DIC

 S DA=+Y

 I +DA>0 S DIE=DIC,DR=".04////"_$$DOCCLASS^TIULC1(TIUATYP) D ^DIE

 K TIUHDR(.01)

 Q +DA

STUFREC(DA,PARENT) ; Stuff look-up header data, etc.

 ; Stuff look-up data, data derived from look-up data, and all other

 ;necessary, known, nontranscribed data: pt, visit, visit-derived data,

 ;entry dt/tm, ref date, capture meth, status (unreleased).

 ; (Remaining transcribed header data is generically stuffed later

 ;in MAIN^TIUPUTC, along with transcribed report text.)

 N FDA,FDARR,IENS,FLAGS,TIUMSG

 S IENS=""""_DA_",""",FDARR="FDA(8925,"_IENS_")",FLAGS="K"

 I +$G(PARENT)'>0 D

 . S @FDARR@(.02)=$G(DFN),@FDARR@(.03)=$P($G(TIU("VISIT")),U)

 . S @FDARR@(.05)=3

 . S @FDARR@(.07)=$P($G(TIU("EDT")),U)

 . S @FDARR@(.08)=$P($G(TIU("LDT")),U)

 . S @FDARR@(1201)=$$NOW^TIULC

 . S @FDARR@(1205)=$S(+$P($G(TIU("LOC")),U):$P($G(TIU("LOC")),U),1:$P($G(TIU("VLOC")),U))

 . ;S @FDARR@(1211)=$P($G(TIU("VLOC")),U)

 . S @FDARR@(1404)=$P($G(TIU("SVC")),U)

 I +$G(PARENT)>0 D

 . S @FDARR@(.02)=+$P($G(^TIU(8925,+PARENT,0)),U,2)

 . S @FDARR@(.03)=+$P($G(^TIU(8925,+PARENT,0)),U,3),@FDARR@(.05)=3

 . S @FDARR@(.06)=PARENT

 . S @FDARR@(.07)=$P($G(^TIU(8925,+PARENT,0)),U,7)

 . S @FDARR@(.08)=$P($G(^TIU(8925,+PARENT,0)),U,8)

 . S @FDARR@(1205)=$P($G(^TIU(8925,+PARENT,12)),U,5)

 . S @FDARR@(1404)=$P($G(^TIU(8925,+PARENT,14)),U,4)

 . S @FDARR@(1201)=$$NOW^TIULC

 S @FDARR@(1205)=$P($G(TIU("LOC")),U)

 S @FDARR@(1212)=$P($G(TIU("INST")),U)

 S @FDARR@(1301)=$S($G(TIUDDT)]"":$$IDATE^TIULC($G(TIUDDT)),1:"")

 I @FDARR@(1301)'>0 S @FDARR@(1301)=$G(@FDARR@(.07))

 S @FDARR@(1303)="U"

 D FILE^DIE(FLAGS,"FDA","TIUMSG") ; File record

 Q

DELTEXT(DA) ; Delete existing text in preparation for replacement

 N DIE,DR,X,Y

 S DIE=8925,DR="2///@" D ^DIE

 Q

WHATYPE(X) ; Identify document type

 ; Receives: X=Document Definition Name

 ;  Returns: Y=Document Definition IFN

 N DIC,Y,TIUFPRIV S TIUFPRIV=1

 S DIC=8925.1,DIC(0)="M"

 S DIC("S")="I +$O(^TIU(8925.1,+Y,""HEAD"",0))!+$O(^TIU(8295.1,+Y,""ITEM"",0))"

 D ^DIC K DIC("S")

WHATYPX Q Y

WHATITLE(X) ; Identify document title

 ; Receives: X=Document Definition Name

 ;  Returns: Y=Document Definition IFN

 N DIC,Y,TIUFPRIV,SCREEN,TIUCLASS S TIUFPRIV=1

 S DIC=8925.1,DIC(0)="M",TIUCLASS=+$$CLASS^TIUCNSLT

 S SCREEN="I $P(^TIU(8925.1,+Y,0),U,4)=""DOC"",+$$ISA^TIULX(+Y,"_TIUCLASS_"),+$$CANPICK^TIULP(+Y)"

 S DIC("S")=SCREEN

 D ^DIC K DIC("S")

WHATITX Q Y

FOLLOWUP(TIUDA) ; Post-filing code for CONSULTS

 N FDA,FDARR,IENS,FLAGS,TIUMSG,TIU,DFN

 S IENS=""""_TIUDA_",""",FDARR="FDA(8925,"_IENS_")",FLAGS="K"

 S @FDARR@(1204)=$$WHOSIGNS^TIULC1(TIUDA)

 I +$P($G(^TIU(8925,TIUDA,12)),U,9),'+$P($G(^(12)),U,8) D

 . S @FDARR@(1208)=$$WHOCOSIG^TIULC1(TIUDA)

 D FILE^DIE(FLAGS,"FDA","TIUMSG")

 I +$P($G(^TIU(8925,+TIUDA,12)),U,8),(+$P($G(^TIU(8925,+TIUDA,12)),U,4)'=+$P($G(^(12)),U,8)) D

 . S @FDARR@(1506)=1 D FILE^DIE(FLAGS,"FDA","TIUMSG")

 D RELEASE^TIUT(TIUDA,1)

 D AUDIT^TIUEDI1(TIUDA,0,$$CHKSUM^TIULC("^TIU(8925,"_+TIUDA_",""TEXT"")"))

 I +$P($G(^TIU(8925,+TIUDA,14)),U,5) D

 . N TIUCDA,DA S TIUCDA=+$P($G(^TIU(8925,+TIUDA,14)),U,5)

 . W !,$$PNAME^TIULC1(+$G(^TIU(8925,+TIUDA,0)))," #: ",TIUDA

 . W " now Linked to Consult Request #: ",TIUCDA,".",!

 . ; Post result in CT Pkg

 . D GET^GMRCTIU(TIUCDA,TIUDA,"INCOMPLETE RPT")

 I '$D(TIU("VSTR")) D

 . N TIUD0,TIUD12,TIUVLOC,TIUHLOC,TIUEDT,TIULDT

 . S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^(12))

 . S DFN=+$P(TIUD0,U,2),TIUEDT=+$P(TIUD0,U,7)

 . S TIULDT=$$FMADD^XLFDT(TIUEDT,1),TIUHLOC=+$P(TIUD12,U,5)

 . S TIUVLOC=$S(+$P(TIUD12,U,11):+$P(TIUD12,U,11),1:+TIUHLOC)

 . I $S(+DFN'>0:1,+TIUEDT'>0:1,+TIULDT'>0:1,+TIUVLOC'>0:1,1:0) Q

 . D MAIN^TIUVSIT(.TIU,DFN,"",TIUEDT,TIULDT,"LAST",0,+TIUVLOC)

 Q:'$D(TIU("VSTR"))

 D QUE^TIUPXAP1 ; Get/file VISIT

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---TIUPUTCN   6351     printed  Feb 19, 2025@00:11:05                                                                                                                                                                                                    Page 2

TIUPUTCN  ; SLC/JER -  Uploading Consult Results ;4/18/03

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**4,100,120,131,113**;Jun 20, 1997

 +2       ; External References in TIUPUTCN:

 +3       ;   DBIA 3472  $$CPPAT^GMRCCP

LOOKUP    ; Lookup Method for Consults document definition

 +1       ; Required: TIUSSN, TIUVDT,TIUCNNBR

 +2        NEW DA,DFN,TIU,TIUDAD,TIUDPRM,TIUEDIT,TIUEDT,TIULDT,TIUXCRP,TIUTYPE,TIUNEW

 +3        IF $SELECT('$DATA(TIUSSN):1,'$DATA(TIUVDT):1,$GET(TIUSSN)?4N:1,$GET(TIUSSN)']"":1,1:0)

               SET Y=-1

               GOTO LOOKUPX

 +4        IF TIUSSN?3N1P2N1P4N.E

               SET TIUSSN=$TRANSLATE(TIUSSN,"-/","")

 +5        IF TIUSSN["?"

               SET Y=-1

               GOTO LOOKUPX

 +6        IF $GET(TIUCNNBR)']""

               SET Y=-1

               GOTO LOOKUPX

 +7        SET TIULOC=+$$ILOC(TIULOC)

 +8        IF '$DATA(^SC(+$GET(TIULOC),0))

               SET Y=-1

               GOTO LOOKUPX

 +9        SET TIUINST=+$$DIVISION^TIULC1(TIULOC)

 +10       SET TIUEDT=$$IDATE^TIULC(TIUVDT)

           SET TIULDT=$$FMADD^XLFDT(TIUEDT,1)

 +11       IF +TIUEDT'>0

               SET Y=-1

               QUIT 

 +12       SET TIUTYPE=$$WHATITLE(TIUTITLE)

 +13       IF +TIUTYPE'>0

               SET Y=-1

               QUIT 

 +14       IF $PIECE($GET(^SC(+TIULOC,0)),U,3)="W"

               Begin DoDot:1

 +15               DO MAIN^TIUMOVE(.TIU,.DFN,TIUSSN,TIUEDT,TIULDT,1,"LAST",0,TIULOC)

               End DoDot:1

               IF 1

 +16      IF '$TEST

               DO MAIN^TIUVSIT(.TIU,.DFN,TIUSSN,TIUEDT,TIULDT,"LAST",0,TIULOC)

 +17       IF $SELECT($DATA(TIU)'>9:1,+$GET(DFN)'>0:1,1:0)

               SET Y=-1

               GOTO LOOKUPX

 +18       IF $PIECE(+$GET(TIU("EDT")),".")'=$PIECE($$IDATE^TIULC(TIUVDT),".")

               SET Y=-1

               GOTO LOOKUPX

 +19      ; Confirm that patient from transcribed Consult Request Number matches

 +20      ;pt from transcribed SSN:

 +21      ; TIU*1*131

           IF '$$CPPAT^GMRCCP(TIUCNNBR,DFN)

               SET Y=-1

               GOTO LOOKUPX

 +22       DO DOCPRM^TIULC1(TIUTYPE,.TIUDPRM)

 +23       SET TIUTYP(1)=1_U_TIUTYPE_U_$$PNAME^TIULC1(TIUTYPE)

 +24       SET Y=$$GETRECNW^TIUEDI3(DFN,.TIU,TIUTYP(1),.TIUNEW,.TIUDPRM)

 +25       IF +Y'>0

               GOTO LOOKUPX

 +26      ; If record is not new, is not yet released, then delete

 +27      ;existing text to prepare for replacement:

 +28       IF +$GET(TIUNEW)'>0

               Begin DoDot:1

 +29               SET TIUEDIT=$$CANEDIT(+Y)

 +30               IF +TIUEDIT>0

                       IF $DATA(^TIU(8925,+Y,"TEXT"))

                           DO DELTEXT(+Y)

 +31      ; If already released, then make an addendum:

 +32               IF +TIUEDIT'>0

                       SET TIUDAD=+Y

                       SET Y=$$MAKEADD

               End DoDot:1

 +33       IF +Y'>0

               QUIT 

 +34      ; Stuff transcribed look-up data, etc.: 

 +35       DO STUFREC(Y,+$GET(TIUDAD))

 +36       IF +$GET(TIUDAD)

               DO SENDADD^TIUALRT(+Y)

 +37      ; Prevent STUFREC^TIUPUTC from overwriting unneeded fields with

 +38      ;possibly erroneous transcribed data:

 +39       KILL TIUHDR(.01),TIUHDR(.07),TIUHDR(1301)

LOOKUPX    QUIT 

ILOC(LOCATION) ; Get pointer to file 44

 +1        NEW DIC,X,Y

 +2        SET DIC=44

           SET DIC(0)="M"

           SET X=LOCATION

           DO ^DIC

 +3        QUIT Y

CANEDIT(DA) ; Check if document is not released yet

 +1       ;TIU*1*131

           QUIT $SELECT(+$PIECE($GET(^TIU(8925,+DA,0)),U,5)<4:1,1:0)

MAKEADD() ; Create an addendum record

 +1        NEW DIE,DR,DA,DIC,X,Y,DLAYGO,TIUATYP,TIUFPRIV

           SET TIUFPRIV=1

 +2       ; Get 8925.1 IEN for title "ADDENDUM"; DON'T require it to be consult

 +3        SET TIUATYP=+$$WHATITLE^TIUPUTU("ADDENDUM")

 +4        SET (DIC,DLAYGO)=8925

           SET DIC(0)="L"

           SET X=""""_"`"_TIUATYP_""""

 +5        DO ^DIC

 +6        SET DA=+Y

 +7        IF +DA>0

               SET DIE=DIC

               SET DR=".04////"_$$DOCCLASS^TIULC1(TIUATYP)

               DO ^DIE

 +8        KILL TIUHDR(.01)

 +9        QUIT +DA

STUFREC(DA,PARENT) ; Stuff look-up header data, etc.

 +1       ; Stuff look-up data, data derived from look-up data, and all other

 +2       ;necessary, known, nontranscribed data: pt, visit, visit-derived data,

 +3       ;entry dt/tm, ref date, capture meth, status (unreleased).

 +4       ; (Remaining transcribed header data is generically stuffed later

 +5       ;in MAIN^TIUPUTC, along with transcribed report text.)

 +6        NEW FDA,FDARR,IENS,FLAGS,TIUMSG

 +7        SET IENS=""""_DA_","""

           SET FDARR="FDA(8925,"_IENS_")"

           SET FLAGS="K"

 +8        IF +$GET(PARENT)'>0

               Begin DoDot:1

 +9                SET @FDARR@(.02)=$GET(DFN)

                   SET @FDARR@(.03)=$PIECE($GET(TIU("VISIT")),U)

 +10               SET @FDARR@(.05)=3

 +11               SET @FDARR@(.07)=$PIECE($GET(TIU("EDT")),U)

 +12               SET @FDARR@(.08)=$PIECE($GET(TIU("LDT")),U)

 +13               SET @FDARR@(1201)=$$NOW^TIULC

 +14               SET @FDARR@(1205)=$SELECT(+$PIECE($GET(TIU("LOC")),U):$PIECE($GET(TIU("LOC")),U),1:$PIECE($GET(TIU("VLOC")),U))

 +15      ;S @FDARR@(1211)=$P($G(TIU("VLOC")),U)

 +16               SET @FDARR@(1404)=$PIECE($GET(TIU("SVC")),U)

               End DoDot:1

 +17       IF +$GET(PARENT)>0

               Begin DoDot:1

 +18               SET @FDARR@(.02)=+$PIECE($GET(^TIU(8925,+PARENT,0)),U,2)

 +19               SET @FDARR@(.03)=+$PIECE($GET(^TIU(8925,+PARENT,0)),U,3)

                   SET @FDARR@(.05)=3

 +20               SET @FDARR@(.06)=PARENT

 +21               SET @FDARR@(.07)=$PIECE($GET(^TIU(8925,+PARENT,0)),U,7)

 +22               SET @FDARR@(.08)=$PIECE($GET(^TIU(8925,+PARENT,0)),U,8)

 +23               SET @FDARR@(1205)=$PIECE($GET(^TIU(8925,+PARENT,12)),U,5)

 +24               SET @FDARR@(1404)=$PIECE($GET(^TIU(8925,+PARENT,14)),U,4)

 +25               SET @FDARR@(1201)=$$NOW^TIULC

               End DoDot:1

 +26       SET @FDARR@(1205)=$PIECE($GET(TIU("LOC")),U)

 +27       SET @FDARR@(1212)=$PIECE($GET(TIU("INST")),U)

 +28       SET @FDARR@(1301)=$SELECT($GET(TIUDDT)]"":$$IDATE^TIULC($GET(TIUDDT)),1:"")

 +29       IF @FDARR@(1301)'>0

               SET @FDARR@(1301)=$GET(@FDARR@(.07))

 +30       SET @FDARR@(1303)="U"

 +31      ; File record

           DO FILE^DIE(FLAGS,"FDA","TIUMSG")

 +32       QUIT 

DELTEXT(DA) ; Delete existing text in preparation for replacement

 +1        NEW DIE,DR,X,Y

 +2        SET DIE=8925

           SET DR="2///@"

           DO ^DIE

 +3        QUIT 

WHATYPE(X) ; Identify document type

 +1       ; Receives: X=Document Definition Name

 +2       ;  Returns: Y=Document Definition IFN

 +3        NEW DIC,Y,TIUFPRIV

           SET TIUFPRIV=1

 +4        SET DIC=8925.1

           SET DIC(0)="M"

 +5        SET DIC("S")="I +$O(^TIU(8925.1,+Y,""HEAD"",0))!+$O(^TIU(8295.1,+Y,""ITEM"",0))"

 +6        DO ^DIC

           KILL DIC("S")

WHATYPX    QUIT Y

WHATITLE(X) ; Identify document title

 +1       ; Receives: X=Document Definition Name

 +2       ;  Returns: Y=Document Definition IFN

 +3        NEW DIC,Y,TIUFPRIV,SCREEN,TIUCLASS

           SET TIUFPRIV=1

 +4        SET DIC=8925.1

           SET DIC(0)="M"

           SET TIUCLASS=+$$CLASS^TIUCNSLT

 +5        SET SCREEN="I $P(^TIU(8925.1,+Y,0),U,4)=""DOC"",+$$ISA^TIULX(+Y,"_TIUCLASS_"),+$$CANPICK^TIULP(+Y)"

 +6        SET DIC("S")=SCREEN

 +7        DO ^DIC

           KILL DIC("S")

WHATITX    QUIT Y

FOLLOWUP(TIUDA) ; Post-filing code for CONSULTS

 +1        NEW FDA,FDARR,IENS,FLAGS,TIUMSG,TIU,DFN

 +2        SET IENS=""""_TIUDA_","""

           SET FDARR="FDA(8925,"_IENS_")"

           SET FLAGS="K"

 +3        SET @FDARR@(1204)=$$WHOSIGNS^TIULC1(TIUDA)

 +4        IF +$PIECE($GET(^TIU(8925,TIUDA,12)),U,9)

               IF '+$PIECE($GET(^(12)),U,8)

                   Begin DoDot:1

 +5                    SET @FDARR@(1208)=$$WHOCOSIG^TIULC1(TIUDA)

                   End DoDot:1

 +6        DO FILE^DIE(FLAGS,"FDA","TIUMSG")

 +7        IF +$PIECE($GET(^TIU(8925,+TIUDA,12)),U,8)

               IF (+$PIECE($GET(^TIU(8925,+TIUDA,12)),U,4)'=+$PIECE($GET(^(12)),U,8))

                   Begin DoDot:1

 +8                    SET @FDARR@(1506)=1

                       DO FILE^DIE(FLAGS,"FDA","TIUMSG")

                   End DoDot:1

 +9        DO RELEASE^TIUT(TIUDA,1)

 +10       DO AUDIT^TIUEDI1(TIUDA,0,$$CHKSUM^TIULC("^TIU(8925,"_+TIUDA_",""TEXT"")"))

 +11       IF +$PIECE($GET(^TIU(8925,+TIUDA,14)),U,5)

               Begin DoDot:1

 +12               NEW TIUCDA,DA

                   SET TIUCDA=+$PIECE($GET(^TIU(8925,+TIUDA,14)),U,5)

 +13               WRITE !,$$PNAME^TIULC1(+$GET(^TIU(8925,+TIUDA,0)))," #: ",TIUDA

 +14               WRITE " now Linked to Consult Request #: ",TIUCDA,".",!

 +15      ; Post result in CT Pkg

 +16               DO GET^GMRCTIU(TIUCDA,TIUDA,"INCOMPLETE RPT")

               End DoDot:1

 +17       IF '$DATA(TIU("VSTR"))

               Begin DoDot:1

 +18               NEW TIUD0,TIUD12,TIUVLOC,TIUHLOC,TIUEDT,TIULDT

 +19               SET TIUD0=$GET(^TIU(8925,+TIUDA,0))

                   SET TIUD12=$GET(^(12))

 +20               SET DFN=+$PIECE(TIUD0,U,2)

                   SET TIUEDT=+$PIECE(TIUD0,U,7)

 +21               SET TIULDT=$$FMADD^XLFDT(TIUEDT,1)

                   SET TIUHLOC=+$PIECE(TIUD12,U,5)

 +22               SET TIUVLOC=$SELECT(+$PIECE(TIUD12,U,11):+$PIECE(TIUD12,U,11),1:+TIUHLOC)

 +23               IF $SELECT(+DFN'>0:1,+TIUEDT'>0:1,+TIULDT'>0:1,+TIUVLOC'>0:1,1:0)

                       QUIT 

 +24               DO MAIN^TIUVSIT(.TIU,DFN,"",TIUEDT,TIULDT,"LAST",0,+TIUVLOC)

               End DoDot:1

 +25       if '$DATA(TIU("VSTR"))

               QUIT 

 +26      ; Get/file VISIT

           DO QUE^TIUPXAP1

 +27       QUIT