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

TIU144.m

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