TIU144 ; SLC/MAM - Consults with Mismatched Patients ;3/6/03
;;1.0;TEXT INTEGRATION UTILITIES;**144**;Jun 20, 1997
; External References
; DBIA 3983 ^GMR(123
; DBIA 3472 $$CPPAT^GMRCCP
BEGIN ; List mismatched Consults
W !!,"Searching for mismatched Consults could take some time. Please"
W !,"remember to queue this option."
W ! K IOP S %ZIS="Q" D ^%ZIS I POP K POP Q
I $D(IO("Q")) K IO("Q") D Q
.S ZTRTN="BUILD^TIU144",ZTSAVE("DUZ")=""
.S ZTDESC="TIU Mismatched Consults List - TIU*1*144"
.D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Canceled!")
.K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
.D HOME^%ZIS
U IO D BUILD,^%ZISC
Q
;
BUILD ; Build array of mismatched Consults
N TIUCVPTR,TIUDA,TIUCNT,CNSLTCLS,NUMFOUND,NUMCHEKD
I $E(IOST)="C" W !!,"Searching for Consult documents with mismatched patients...",!
S CNSLTCLS=$$CLASS^TIUCNSLT()
S TIUCVPTR="",NUMCHEKD=0
F S TIUCVPTR=$O(^TIU(8925,"G",TIUCVPTR)) Q:TIUCVPTR="" D
. ; -- If Requesting Pkg IEN is 0 or -1, exclude document:
. Q:TIUCVPTR'>0
. ; -- If Req Pkg has file but it's not GMR(123, exclude document:
. I $P(TIUCVPTR,";",2)]"",$P(TIUCVPTR,";",2)'="GMR(123," Q
. S TIUDA=0
. F S TIUDA=+$O(^TIU(8925,"G",TIUCVPTR,TIUDA)) Q:'TIUDA D
. . N DFN,TIUCNNBR,OK,TIUD0,TIUD13,DOC,TIUDAD,TIUDAD0,TITLDA,CAPTURE
. . N PT,EDT,STATX,CNSLTPT,CNSLTEDT,TOSERV,CNSLTST,TIUMATCH,LOC,TIUD12
. . N DIC,DR,DA,DIQ,DIV,EXTRA,CNSLT1,CNSLT2
. . S TIUD0=$G(^TIU(8925,TIUDA,0)),DFN=+$P(TIUD0,U,2)
. . S TITLDA=+TIUD0,NUMCHEKD=NUMCHEKD+1
. . ; --If Req Pkg lacks file, & docmt is not a Consult, exclude docmt:
. . I $P(TIUCVPTR,";",2)="",'$$ISA^TIULX(TITLDA,CNSLTCLS) Q
. . S STATX=$P($G(^TIU(8925.6,+$P(TIUD0,U,5),0)),U)
. . Q:STATX="RETRACTED"
. . Q:STATX="DELETED"
. . S TIUCNNBR=+$P(TIUCVPTR,";")
. . S OK=$$CPPAT^GMRCCP(TIUCNNBR,DFN)
. . Q:OK>0
. . ; --If docmt is not a Consult, exclude docmt:
. . I TITLDA'=81,'$$ISA^TIULX(TITLDA,CNSLTCLS) Q
. . I TITLDA=81 S TIUDAD=+$P(TIUD0,U,6),TIUDAD0=$G(^TIU(8925,TIUDAD,0)) I '$$ISA^TIULX(+TIUDAD0,CNSLTCLS) Q
. . S TIUD13=$G(^TIU(8925,TIUDA,13))
. . S CAPTURE=$P(TIUD13,U,3)
. . S DOC=$E($$PNAME^TIULC1(+TIUD0),1,39)
. . S PT=$$PATIENT(DFN)
. . S EDT=$$DATE^TIULS($P(TIUD13,U),"MM/DD/YY")
. . S TIUD12=$G(^TIU(8925,TIUDA,12))
. . S LOC=+$P(TIUD12,U,5)
. . S DIV=+$P($G(^SC(LOC,0)),U,4)
. . S DIC="^GMR(123,",DR=".02;1;3;8"
. . S DA=TIUCNNBR,DIQ(0)="IE",DIQ="TIUMATCH"
. . D EN^DIQ1
. . S CNSLTPT=+$G(TIUMATCH(123,DA,.02,"I"))
. . S CNSLTEDT=$G(TIUMATCH(123,DA,3,"I")),CNSLTEDT=$$DATE^TIULS(CNSLTEDT,"MM/DD/YY")
. . S TOSERV=$E($G(TIUMATCH(123,DA,1,"E")),1,40)
. . S CNSLTPT=$$PATIENT(CNSLTPT)
. . S CNSLTST=$G(TIUMATCH(123,DA,8,"E"))
. . S CNSLTST=$S(CNSLTST="DISCONTINUED":"(dc)",1:"")
. . S TIUCNT=+$G(TIUCNT)+1
. . S ^TMP("TIU144",$J,DIV,TITLDA,TIUCNT,"DOCMT")=DOC_U_TIUDA_U_PT_U_EDT_U_CAPTURE_U_STATX
. . S ^TMP("TIU144",$J,DIV,TITLDA,TIUCNT,"CNSLT")=TOSERV_U_TIUCNNBR_U_CNSLTPT_U_CNSLTEDT_U_CNSLTST
. . ; -- Add lines about parent if docmt is addendum:
. . I TITLDA=81 D
. . . N DADDFN,TIUDAD13,DADDOC,DADPT,DADEDT,DADSTATX
. . . S DADDFN=$P(TIUDAD0,U,2) Q:'DADDFN
. . . S DADSTATX=$P($G(^TIU(8925.6,+$P(TIUDAD0,U,5),0)),U)
. . . S TIUDAD13=$G(^TIU(8925,TIUDAD,13))
. . . S DADDOC=$E($$PNAME^TIULC1(+TIUDAD0),1,40)
. . . S DADPT=$$PATIENT(DADDFN)
. . . S DADEDT=$$DATE^TIULS($P(TIUDAD13,U),"MM/DD/YY")
. . . S ^TMP("TIU144",$J,DIV,TITLDA,TIUCNT,"DADDOCMT")=DADDOC_U_TIUDAD_U_DADPT_U_DADEDT_U_DADSTATX
. . Q:TIUCNNBR'>0
. . S EXTRA=0
. . S CNSLT1=+$O(^GMR(123,"R",TIUDA_";TIU(8925,",0))
. . Q:CNSLT1'>0
. . I CNSLT1'=TIUCNNBR S EXTRA=CNSLT1
. . I 'EXTRA S CNSLT2=+$O(^GMR(123,"R",TIUDA_";TIU(8925,",CNSLT1))
. . I $G(CNSLT2)>0,CNSLT2'=TIUCNNBR S EXTRA=CNSLT2
. . I +EXTRA S ^TMP("TIU144",$J,DIV,TITLDA,TIUCNT,"EXTRA")=EXTRA
S NUMFOUND=+$G(TIUCNT)
D PRINT(NUMCHEKD,NUMFOUND)
K ^TMP("TIU144",$J)
Q
;
PATIENT(PTDA) ; Return Patient Name & last 4 of SSN
; Receives Patient file IEN
N PT,LASTI,LAST4
S PT=$$NAME^TIULS($$PTNAME^TIULC1(+PTDA),"LAST,FI MI")
S LASTI=$E(PT)
S LAST4=$E($P($G(^DPT(+PTDA,0)),U,9),6,9)
S LAST4="("_LASTI_LAST4_")"
S PT=PT_" "_LAST4
Q PT
PRINT(CHEKD,FOUND) ; Print
N TIUCNT,TIUCONT,DOCDATA,DADDATA,CNDATA,TITLDA,DIV,EXTDIV,MISMNUM
I $D(ZTQUEUED) S ZTREQ="@" ; Tell TaskMan to delete Task log entry
I $E(IOST)="C" W @IOF,!
W " Consult Documents with Mismatched Patients"
W !!," ",CHEKD," documents processed"
I 'FOUND W !," No mismatches found" G PRINTX
W !," ",FOUND," mismatched documents found"
W !!," In listed mismatches, the patient for the request associated with the"
W !,"document does not match the patient for the document. See the description for"
W !,"patch TIU*1*144 in the National Patch Module for further explanation of this"
W !,"display and for instructions on how to correct listed entries.",!!
;W " In addition to patient mismatches, this list may contain some Consult Results",!,"which are not linked to any request.",!!
S DIV="",TIUCONT=1,MISMNUM=0
F S DIV=$O(^TMP("TIU144",$J,DIV)) Q:DIV="" D Q:'TIUCONT
. I DIV'=$O(^TMP("TIU144",$J,"")) D Q:'TIUCONT
. . I $E(IOST)="C" W !! S TIUCONT=$$STOP Q
. . W @IOF
. S EXTDIV=$$EXTERNAL^DILFD(44,3,"",DIV)
. I EXTDIV']"" S EXTDIV="UNKNOWN"
. W "===============================================================================",!
. W " Division: ",EXTDIV
. W !,"==============================================================================="
. S TITLDA=""
. F S TITLDA=$O(^TMP("TIU144",$J,DIV,TITLDA)) Q:TITLDA="" D Q:'TIUCONT
. . S TIUCNT=""
. . F S TIUCNT=$O(^TMP("TIU144",$J,DIV,TITLDA,TIUCNT)) Q:TIUCNT="" D Q:'TIUCONT
. . . W !!
. . . S TIUCONT=$$SETCONT Q:'TIUCONT
. . . S DOCDATA=^TMP("TIU144",$J,DIV,TITLDA,TIUCNT,"DOCMT")
. . . S MISMNUM=MISMNUM+1
. . . W ?2,MISMNUM,".",?7,"Note Title: ",$P(DOCDATA,U),?59,"#: ",$P(DOCDATA,U,2),?72,"Capt: ",$P(DOCDATA,U,5)
. . . W !,?2,"Pt: ",$P(DOCDATA,U,3),?59,"Rf Date: ",$P(DOCDATA,U,4)
. . . S CNDATA=^TMP("TIU144",$J,DIV,TITLDA,TIUCNT,"CNSLT")
. . . W !,?2,"Cnslt To Serv: ",$P(CNDATA,U),?59,"Cnslt #: ",$P(CNDATA,U,2),?75,$P(CNDATA,U,5)
. . . W !,?2,"Pt: ",$P(CNDATA,U,3),?59,"Date: ",$P(CNDATA,U,4)
. . . S DADDATA=$G(^TMP("TIU144",$J,DIV,TITLDA,TIUCNT,"DADDOCMT"))
. . . I DADDATA]"" D
. . . . W !,?2,"Parent Title: ",$P(DADDATA,U),?59,"#: ",$P(DADDATA,U,2)
. . . . W !,?2,"Rf Date: ",$P(DADDATA,U,4)
. . . I $D(^TMP("TIU144",$J,DIV,TITLDA,TIUCNT,"EXTRA")) W !,?2,"Consult # ",^TMP("TIU144",$J,DIV,TITLDA,TIUCNT,"EXTRA")," is ALSO linked to this document on the Consults side."
PRINTX I $G(TIUCONT) W !! S TIUCONT=$$SETCONT W ?5,"================ ",FOUND," Mismatches Found."," ================="
D MAIL(CHEKD,FOUND)
Q
MAIL(CHEKD,FOUND) ; Send msg to person who ran option & Pt Safety Committee
N XMSUB,XMTEXT,XMDUZ,XMY,XMZ,XMMG,TIUTXT
S XMDUZ="PATCH TIU*1*144 MISMATCHED CONSULTS SEARCH OPTION"
S:$G(DUZ) XMY(DUZ)=""
S XMY("G.PATIENT SAFETY NOTIFICATIONS")="",XMY(.5)=""
S TIUTXT(1)="TIU Consult Documents Linked to Different Patient's Request"
S TIUTXT(2)=""
S TIUTXT(3)="Search completed successfully on "_$$FMTE^XLFDT($$NOW^XLFDT)
S TIUTXT(4)="Number of TIU documents processed: "_CHEKD
S TIUTXT(5)="Number of mismatched documents found: "_FOUND
S TIUTXT(6)=""
S TIUTXT(7)="These documents should be cleaned up manually, using TIU Document Management"
S TIUTXT(8)="options. For more information, see patch TIU*1*144 in the National Patch"
S TIUTXT(9)="Module on FORUM, or contact "_$S($G(DUZ):$P(^VA(200,DUZ,0),"^"),1:"IRM")_"."
S XMTEXT="TIUTXT(",XMSUB="TIU*1*144 Mismatched TIU Consult Documents"
D ^XMD
Q
STOP() ;on screen paging check
; quits TIUCONT=1 if cont. ELSE quits TIUCONT=0
N DIR,Y,TIUCONT
S DIR(0)="E" D ^DIR
S TIUCONT=Y
I TIUCONT W @IOF,!
Q TIUCONT
;
SETCONT() ; D form feed, Set TIUCONT
N TIUCONT
S TIUCONT=1
I $E(IOST)="C" G SETX:$Y+8<IOSL
I $E(IOST)="C" S TIUCONT=$$STOP G SETX
G:$Y+7<IOSL SETX
W @IOF
SETX Q TIUCONT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIU144 8166 printed Oct 16, 2024@18:38:57 Page 2
TIU144 ; SLC/MAM - Consults with Mismatched Patients ;3/6/03
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**144**;Jun 20, 1997
+2 ; External References
+3 ; DBIA 3983 ^GMR(123
+4 ; DBIA 3472 $$CPPAT^GMRCCP
BEGIN ; List mismatched Consults
+1 WRITE !!,"Searching for mismatched Consults could take some time. Please"
+2 WRITE !,"remember to queue this option."
+3 WRITE !
KILL IOP
SET %ZIS="Q"
DO ^%ZIS
IF POP
KILL POP
QUIT
+4 IF $DATA(IO("Q"))
KILL IO("Q")
Begin DoDot:1
+5 SET ZTRTN="BUILD^TIU144"
SET ZTSAVE("DUZ")=""
+6 SET ZTDESC="TIU Mismatched Consults List - TIU*1*144"
+7 DO ^%ZTLOAD
WRITE !,$SELECT($DATA(ZTSK):"Request Queued!",1:"Request Canceled!")
+8 KILL ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
+9 DO HOME^%ZIS
End DoDot:1
QUIT
+10 USE IO
DO BUILD
DO ^%ZISC
+11 QUIT
+12 ;
BUILD ; Build array of mismatched Consults
+1 NEW TIUCVPTR,TIUDA,TIUCNT,CNSLTCLS,NUMFOUND,NUMCHEKD
+2 IF $EXTRACT(IOST)="C"
WRITE !!,"Searching for Consult documents with mismatched patients...",!
+3 SET CNSLTCLS=$$CLASS^TIUCNSLT()
+4 SET TIUCVPTR=""
SET NUMCHEKD=0
+5 FOR
SET TIUCVPTR=$ORDER(^TIU(8925,"G",TIUCVPTR))
if TIUCVPTR=""
QUIT
Begin DoDot:1
+6 ; -- If Requesting Pkg IEN is 0 or -1, exclude document:
+7 if TIUCVPTR'>0
QUIT
+8 ; -- If Req Pkg has file but it's not GMR(123, exclude document:
+9 IF $PIECE(TIUCVPTR,";",2)]""
IF $PIECE(TIUCVPTR,";",2)'="GMR(123,"
QUIT
+10 SET TIUDA=0
+11 FOR
SET TIUDA=+$ORDER(^TIU(8925,"G",TIUCVPTR,TIUDA))
if 'TIUDA
QUIT
Begin DoDot:2
+12 NEW DFN,TIUCNNBR,OK,TIUD0,TIUD13,DOC,TIUDAD,TIUDAD0,TITLDA,CAPTURE
+13 NEW PT,EDT,STATX,CNSLTPT,CNSLTEDT,TOSERV,CNSLTST,TIUMATCH,LOC,TIUD12
+14 NEW DIC,DR,DA,DIQ,DIV,EXTRA,CNSLT1,CNSLT2
+15 SET TIUD0=$GET(^TIU(8925,TIUDA,0))
SET DFN=+$PIECE(TIUD0,U,2)
+16 SET TITLDA=+TIUD0
SET NUMCHEKD=NUMCHEKD+1
+17 ; --If Req Pkg lacks file, & docmt is not a Consult, exclude docmt:
+18 IF $PIECE(TIUCVPTR,";",2)=""
IF '$$ISA^TIULX(TITLDA,CNSLTCLS)
QUIT
+19 SET STATX=$PIECE($GET(^TIU(8925.6,+$PIECE(TIUD0,U,5),0)),U)
+20 if STATX="RETRACTED"
QUIT
+21 if STATX="DELETED"
QUIT
+22 SET TIUCNNBR=+$PIECE(TIUCVPTR,";")
+23 SET OK=$$CPPAT^GMRCCP(TIUCNNBR,DFN)
+24 if OK>0
QUIT
+25 ; --If docmt is not a Consult, exclude docmt:
+26 IF TITLDA'=81
IF '$$ISA^TIULX(TITLDA,CNSLTCLS)
QUIT
+27 IF TITLDA=81
SET TIUDAD=+$PIECE(TIUD0,U,6)
SET TIUDAD0=$GET(^TIU(8925,TIUDAD,0))
IF '$$ISA^TIULX(+TIUDAD0,CNSLTCLS)
QUIT
+28 SET TIUD13=$GET(^TIU(8925,TIUDA,13))
+29 SET CAPTURE=$PIECE(TIUD13,U,3)
+30 SET DOC=$EXTRACT($$PNAME^TIULC1(+TIUD0),1,39)
+31 SET PT=$$PATIENT(DFN)
+32 SET EDT=$$DATE^TIULS($PIECE(TIUD13,U),"MM/DD/YY")
+33 SET TIUD12=$GET(^TIU(8925,TIUDA,12))
+34 SET LOC=+$PIECE(TIUD12,U,5)
+35 SET DIV=+$PIECE($GET(^SC(LOC,0)),U,4)
+36 SET DIC="^GMR(123,"
SET DR=".02;1;3;8"
+37 SET DA=TIUCNNBR
SET DIQ(0)="IE"
SET DIQ="TIUMATCH"
+38 DO EN^DIQ1
+39 SET CNSLTPT=+$GET(TIUMATCH(123,DA,.02,"I"))
+40 SET CNSLTEDT=$GET(TIUMATCH(123,DA,3,"I"))
SET CNSLTEDT=$$DATE^TIULS(CNSLTEDT,"MM/DD/YY")
+41 SET TOSERV=$EXTRACT($GET(TIUMATCH(123,DA,1,"E")),1,40)
+42 SET CNSLTPT=$$PATIENT(CNSLTPT)
+43 SET CNSLTST=$GET(TIUMATCH(123,DA,8,"E"))
+44 SET CNSLTST=$SELECT(CNSLTST="DISCONTINUED":"(dc)",1:"")
+45 SET TIUCNT=+$GET(TIUCNT)+1
+46 SET ^TMP("TIU144",$JOB,DIV,TITLDA,TIUCNT,"DOCMT")=DOC_U_TIUDA_U_PT_U_EDT_U_CAPTURE_U_STATX
+47 SET ^TMP("TIU144",$JOB,DIV,TITLDA,TIUCNT,"CNSLT")=TOSERV_U_TIUCNNBR_U_CNSLTPT_U_CNSLTEDT_U_CNSLTST
+48 ; -- Add lines about parent if docmt is addendum:
+49 IF TITLDA=81
Begin DoDot:3
+50 NEW DADDFN,TIUDAD13,DADDOC,DADPT,DADEDT,DADSTATX
+51 SET DADDFN=$PIECE(TIUDAD0,U,2)
if 'DADDFN
QUIT
+52 SET DADSTATX=$PIECE($GET(^TIU(8925.6,+$PIECE(TIUDAD0,U,5),0)),U)
+53 SET TIUDAD13=$GET(^TIU(8925,TIUDAD,13))
+54 SET DADDOC=$EXTRACT($$PNAME^TIULC1(+TIUDAD0),1,40)
+55 SET DADPT=$$PATIENT(DADDFN)
+56 SET DADEDT=$$DATE^TIULS($PIECE(TIUDAD13,U),"MM/DD/YY")
+57 SET ^TMP("TIU144",$JOB,DIV,TITLDA,TIUCNT,"DADDOCMT")=DADDOC_U_TIUDAD_U_DADPT_U_DADEDT_U_DADSTATX
End DoDot:3
+58 if TIUCNNBR'>0
QUIT
+59 SET EXTRA=0
+60 SET CNSLT1=+$ORDER(^GMR(123,"R",TIUDA_";TIU(8925,",0))
+61 if CNSLT1'>0
QUIT
+62 IF CNSLT1'=TIUCNNBR
SET EXTRA=CNSLT1
+63 IF 'EXTRA
SET CNSLT2=+$ORDER(^GMR(123,"R",TIUDA_";TIU(8925,",CNSLT1))
+64 IF $GET(CNSLT2)>0
IF CNSLT2'=TIUCNNBR
SET EXTRA=CNSLT2
+65 IF +EXTRA
SET ^TMP("TIU144",$JOB,DIV,TITLDA,TIUCNT,"EXTRA")=EXTRA
End DoDot:2
End DoDot:1
+66 SET NUMFOUND=+$GET(TIUCNT)
+67 DO PRINT(NUMCHEKD,NUMFOUND)
+68 KILL ^TMP("TIU144",$JOB)
+69 QUIT
+70 ;
PATIENT(PTDA) ; Return Patient Name & last 4 of SSN
+1 ; Receives Patient file IEN
+2 NEW PT,LASTI,LAST4
+3 SET PT=$$NAME^TIULS($$PTNAME^TIULC1(+PTDA),"LAST,FI MI")
+4 SET LASTI=$EXTRACT(PT)
+5 SET LAST4=$EXTRACT($PIECE($GET(^DPT(+PTDA,0)),U,9),6,9)
+6 SET LAST4="("_LASTI_LAST4_")"
+7 SET PT=PT_" "_LAST4
+8 QUIT PT
PRINT(CHEKD,FOUND) ; Print
+1 NEW TIUCNT,TIUCONT,DOCDATA,DADDATA,CNDATA,TITLDA,DIV,EXTDIV,MISMNUM
+2 ; Tell TaskMan to delete Task log entry
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 IF $EXTRACT(IOST)="C"
WRITE @IOF,!
+4 WRITE " Consult Documents with Mismatched Patients"
+5 WRITE !!," ",CHEKD," documents processed"
+6 IF 'FOUND
WRITE !," No mismatches found"
GOTO PRINTX
+7 WRITE !," ",FOUND," mismatched documents found"
+8 WRITE !!," In listed mismatches, the patient for the request associated with the"
+9 WRITE !,"document does not match the patient for the document. See the description for"
+10 WRITE !,"patch TIU*1*144 in the National Patch Module for further explanation of this"
+11 WRITE !,"display and for instructions on how to correct listed entries.",!!
+12 ;W " In addition to patient mismatches, this list may contain some Consult Results",!,"which are not linked to any request.",!!
+13 SET DIV=""
SET TIUCONT=1
SET MISMNUM=0
+14 FOR
SET DIV=$ORDER(^TMP("TIU144",$JOB,DIV))
if DIV=""
QUIT
Begin DoDot:1
+15 IF DIV'=$ORDER(^TMP("TIU144",$JOB,""))
Begin DoDot:2
+16 IF $EXTRACT(IOST)="C"
WRITE !!
SET TIUCONT=$$STOP
QUIT
+17 WRITE @IOF
End DoDot:2
if 'TIUCONT
QUIT
+18 SET EXTDIV=$$EXTERNAL^DILFD(44,3,"",DIV)
+19 IF EXTDIV']""
SET EXTDIV="UNKNOWN"
+20 WRITE "===============================================================================",!
+21 WRITE " Division: ",EXTDIV
+22 WRITE !,"==============================================================================="
+23 SET TITLDA=""
+24 FOR
SET TITLDA=$ORDER(^TMP("TIU144",$JOB,DIV,TITLDA))
if TITLDA=""
QUIT
Begin DoDot:2
+25 SET TIUCNT=""
+26 FOR
SET TIUCNT=$ORDER(^TMP("TIU144",$JOB,DIV,TITLDA,TIUCNT))
if TIUCNT=""
QUIT
Begin DoDot:3
+27 WRITE !!
+28 SET TIUCONT=$$SETCONT
if 'TIUCONT
QUIT
+29 SET DOCDATA=^TMP("TIU144",$JOB,DIV,TITLDA,TIUCNT,"DOCMT")
+30 SET MISMNUM=MISMNUM+1
+31 WRITE ?2,MISMNUM,".",?7,"Note Title: ",$PIECE(DOCDATA,U),?59,"#: ",$PIECE(DOCDATA,U,2),?72,"Capt: ",$PIECE(DOCDATA,U,5)
+32 WRITE !,?2,"Pt: ",$PIECE(DOCDATA,U,3),?59,"Rf Date: ",$PIECE(DOCDATA,U,4)
+33 SET CNDATA=^TMP("TIU144",$JOB,DIV,TITLDA,TIUCNT,"CNSLT")
+34 WRITE !,?2,"Cnslt To Serv: ",$PIECE(CNDATA,U),?59,"Cnslt #: ",$PIECE(CNDATA,U,2),?75,$PIECE(CNDATA,U,5)
+35 WRITE !,?2,"Pt: ",$PIECE(CNDATA,U,3),?59,"Date: ",$PIECE(CNDATA,U,4)
+36 SET DADDATA=$GET(^TMP("TIU144",$JOB,DIV,TITLDA,TIUCNT,"DADDOCMT"))
+37 IF DADDATA]""
Begin DoDot:4
+38 WRITE !,?2,"Parent Title: ",$PIECE(DADDATA,U),?59,"#: ",$PIECE(DADDATA,U,2)
+39 WRITE !,?2,"Rf Date: ",$PIECE(DADDATA,U,4)
End DoDot:4
+40 IF $DATA(^TMP("TIU144",$JOB,DIV,TITLDA,TIUCNT,"EXTRA"))
WRITE !,?2,"Consult # ",^TMP("TIU144",$JOB,DIV,TITLDA,TIUCNT,"EXTRA")," is ALSO linked to this document on the Consults side."
End DoDot:3
if 'TIUCONT
QUIT
End DoDot:2
if 'TIUCONT
QUIT
End DoDot:1
if 'TIUCONT
QUIT
PRINTX IF $GET(TIUCONT)
WRITE !!
SET TIUCONT=$$SETCONT
WRITE ?5,"================ ",FOUND," Mismatches Found."," ================="
+1 DO MAIL(CHEKD,FOUND)
+2 QUIT
MAIL(CHEKD,FOUND) ; Send msg to person who ran option & Pt Safety Committee
+1 NEW XMSUB,XMTEXT,XMDUZ,XMY,XMZ,XMMG,TIUTXT
+2 SET XMDUZ="PATCH TIU*1*144 MISMATCHED CONSULTS SEARCH OPTION"
+3 if $GET(DUZ)
SET XMY(DUZ)=""
+4 SET XMY("G.PATIENT SAFETY NOTIFICATIONS")=""
SET XMY(.5)=""
+5 SET TIUTXT(1)="TIU Consult Documents Linked to Different Patient's Request"
+6 SET TIUTXT(2)=""
+7 SET TIUTXT(3)="Search completed successfully on "_$$FMTE^XLFDT($$NOW^XLFDT)
+8 SET TIUTXT(4)="Number of TIU documents processed: "_CHEKD
+9 SET TIUTXT(5)="Number of mismatched documents found: "_FOUND
+10 SET TIUTXT(6)=""
+11 SET TIUTXT(7)="These documents should be cleaned up manually, using TIU Document Management"
+12 SET TIUTXT(8)="options. For more information, see patch TIU*1*144 in the National Patch"
+13 SET TIUTXT(9)="Module on FORUM, or contact "_$SELECT($GET(DUZ):$PIECE(^VA(200,DUZ,0),"^"),1:"IRM")_"."
+14 SET XMTEXT="TIUTXT("
SET XMSUB="TIU*1*144 Mismatched TIU Consult Documents"
+15 DO ^XMD
+16 QUIT
STOP() ;on screen paging check
+1 ; quits TIUCONT=1 if cont. ELSE quits TIUCONT=0
+2 NEW DIR,Y,TIUCONT
+3 SET DIR(0)="E"
DO ^DIR
+4 SET TIUCONT=Y
+5 IF TIUCONT
WRITE @IOF,!
+6 QUIT TIUCONT
+7 ;
SETCONT() ; D form feed, Set TIUCONT
+1 NEW TIUCONT
+2 SET TIUCONT=1
+3 IF $EXTRACT(IOST)="C"
if $Y+8<IOSL
GOTO SETX
+4 IF $EXTRACT(IOST)="C"
SET TIUCONT=$$STOP
GOTO SETX
+5 if $Y+7<IOSL
GOTO SETX
+6 WRITE @IOF
SETX QUIT TIUCONT
