176 lines
7.8 KiB
Mathematica
176 lines
7.8 KiB
Mathematica
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
|