TIU214 ; VMP/JML - ID NOTES with Mismatched Patients ;3/31/06 ; Compiled March 13, 2006 15:21:26
;;1.0;TEXT INTEGRATION UTILITIES;**214**;Jun 20, 1997
; Report/Fix ID Documents where the child note points to a parent note for a different patient.
; Report only Documents where the child note points to a parent that may not be an id note.
Q
EN ; Build array of mismatched ID documents
N TIUPRNT,TIUCHILD,TIUPDFN,TIUCDFN,TIUPNAME,TIUCNAME,TIUP0,TIUC0,TIUCAUTH,TIUCTITL,TIUDATA,TIUBAD
N TIUC12,TIUCEDT,TIUPAUTH,TIUPTITL,TIUP12,TIUPEDT,TIUFIX,Y,DFN,%ZIS,POP,DIR,DIRUT,TIULEN,TIUDUZ
S DIR(0)="SO^1:REPORT;2:FIX"
S DIR("L",1)="Report only or Report AND fix the bad pointers?"
S DIR("L",2)=""
S DIR("L",3)="1 - Report Only"
S DIR("L")="2 - Report and Fix"
S DIR("B")=1
D ^DIR K DIR
Q:$G(DIRUT)
S TIUFIX=$S(Y=2:1,1:0),TIUDUZ=$G(DUZ)
S %ZIS="Q" D ^%ZIS
Q:$G(POP)>0
I $G(IO("Q"))=1 D Q
.N ZTRTN,ZTDESC,ZTSAVE
.S ZTRTN="SEARCH^TIU214",ZTDESC="Mismatched ID Note Report",ZTSAVE("TIU*")=""
.D ^%ZTLOAD K IO("Q")
SEARCH ;
K ^TMP("TIU214",$J)
S ^TMP("TIU214",$J)=0,^TMP("TIU214",$J,"MISMATCH")=0,^TMP("TIU214",$J,"MISSING")=0,^TMP("TIU214",$J,"NONPRNT")=0
I $E(IOST,1,2)="C-" W @IOF,!!?5,"Searching for Parent/Child ID Notes with mismatched patients...",!!
S TIUPRNT=0
F S TIUPRNT=$O(^TIU(8925,"GDAD",TIUPRNT)) Q:TIUPRNT="" D
. S ^TMP("TIU214",$J)=^TMP("TIU214",$J)+1
. S TIUCHILD=0
. F S TIUCHILD=+$O(^TIU(8925,"GDAD",TIUPRNT,TIUCHILD)) Q:'TIUCHILD D
. . S TIUC0=$G(^TIU(8925,TIUCHILD,0)),TIUCDFN=$P(TIUC0,U,2)
. . S TIUCNAME=$$PNAME(TIUCDFN)
. . S TIUCAUTH=$$GET1^DIQ(8925,TIUCHILD_",",1202)
. . S TIUCTITL=$$GET1^DIQ(8925,TIUCHILD_",",.01)
. . S TIUC12=$G(^TIU(8925,TIUCHILD,12))
. . S Y=$P(TIUC12,"^") D DD^%DT S TIUCEDT=Y
. . S TIUP0=$G(^TIU(8925,TIUPRNT,0)),TIUPDFN=$P(TIUP0,U,2)
. . I TIUP0="" D Q
. . . S ^TMP("TIU214",$J,"MISSING")=^TMP("TIU214",$J,"MISSING")+1
. . . S ^TMP("TIU214",$J,"MISSING",TIUPRNT,TIUCHILD)=TIUCNAME_"^"_TIUCTITL_"^"_TIUCEDT_"^"_TIUCAUTH
. . I TIUPDFN'=TIUCDFN D Q
. . . S TIUPNAME=$$PNAME(TIUPDFN)
. . . S ^TMP("TIU214",$J,"MISMATCH")=^TMP("TIU214",$J,"MISMATCH")+1
. . . I '$D(^TMP("TIU214",$J,"MISMATCH",TIUPRNT)) D
. . . . S TIUPAUTH=$$GET1^DIQ(8925,TIUPRNT_",",1202)
. . . . S TIUPTITL=$$GET1^DIQ(8925,TIUPRNT_",",.01)
. . . . S TIUP12=$G(^TIU(8925,TIUPRNT,12))
. . . . S Y=$P(TIUP12,"^") D DD^%DT S TIUPEDT=Y
. . . . S ^TMP("TIU214",$J,"MISMATCH",TIUPRNT)=TIUPNAME_"^"_TIUPTITL_"^"_TIUPEDT_"^"_TIUPAUTH_"^"_TIUPRNT
. . . S ^TMP("TIU214",$J,"MISMATCH",TIUPRNT,TIUCHILD)=TIUCNAME_"^"_TIUCTITL_"^"_TIUCEDT_"^"_TIUCAUTH_"^"_TIUCHILD
. . S TIUBAD="" S TIUBAD=$$POSSPRNT^TIULP(+TIUP0) I '+TIUBAD D Q
. . . S ^TMP("TIU214",$J,"NONPRNT")=^TMP("TIU214",$J,"NONPRNT")+1
. . . S TIUPAUTH=$$GET1^DIQ(8925,TIUPRNT_",",1202)
. . . S TIUPTITL=$$GET1^DIQ(8925,TIUPRNT_",",.01)
. . . S TIUP12=$G(^TIU(8925,TIUPRNT,12))
. . . S Y=$P(TIUP12,"^") D DD^%DT S TIUPEDT=Y
. . . S ^TMP("TIU214",$J,"NONPRNT",TIUPRNT,TIUCHILD)=TIUCNAME_"^"_TIUPTITL_"^"_TIUPEDT_"^"_TIUPAUTH_"^"_TIUPRNT_"^"_TIUCTITL
D REPORT
D MAIL
K ^TMP("TIU214",$J)
D ^%ZISC
Q
REPORT ;
U IO
N TIUQUIT,TIUHIDE,TIUCINFO,TIUPINFO,TIUSHOW
S TIUQUIT=0,TIUSHOW=$S(IOST["P-":0,1:1)
S ^TMP("TIU214",$J,"FIX_MISMATCH_PTR")=0,^TMP("TIU214",$J,"FIX_MISMATCH_XREF")=0
S ^TMP("TIU214",$J,"FIX_MISSING_PTR")=0,^TMP("TIU214",$J,"FIX_MISSING_XREF")=0
I IOST["C-" D CLEAR^VALM1
S TIUDATA=0,TIULEN=$S(IOST["C-":8,1:6)
I TIUFIX S TIULEN=TIULEN+1
D HDR1(0)
S TIUPRNT=""
F S TIUPRNT=$O(^TMP("TIU214",$J,"MISMATCH",TIUPRNT)) Q:TIUPRNT=""!(TIUQUIT) D
.S TIUPINFO=$G(^TMP("TIU214",$J,"MISMATCH",TIUPRNT))
.S TIUCHILD=""
.F S TIUCHILD=$O(^TMP("TIU214",$J,"MISMATCH",TIUPRNT,TIUCHILD)) Q:TIUCHILD=""!(TIUQUIT) D
..S TIUCINFO=$G(^TMP("TIU214",$J,"MISMATCH",TIUPRNT,TIUCHILD))
..I $Y>(IOSL-TIULEN) D PAUSE Q:TIUQUIT D HDR1(1)
..I TIUSHOW D
...W !!," Patient: ",$E($P(TIUCINFO,"^",1),1,26)," (",$P(TIUCINFO,"^",2),")"
...W ?45,$E($P(TIUPINFO,"^",1),1,26)," (",$P(TIUPINFO,"^",2),")"
..I 'TIUSHOW D
...W !!," Patient: ",$P(TIUCINFO,"^",2)
...W ?45,$P(TIUPINFO,"^",2)
..W !," Title: ",$E($P(TIUCINFO,"^",3),1,33),?45,$E($P(TIUPINFO,"^",3),1,33)
..W !,"Entry DT: ",$E($P(TIUCINFO,"^",4),1,33),?45,$E($P(TIUPINFO,"^",4),1,33)
..W !," Author: ",$E($P(TIUCINFO,"^",5),1,33),?45,$E($P(TIUPINFO,"^",5),1,33)
..W !,"Note IEN: ",$E($P(TIUCINFO,"^",6),1,33),?45,$E($P(TIUPINFO,"^",6),1,33)
..I TIUFIX D
...I $G(^TIU(8925,TIUCHILD,21))=TIUPRNT D Q
....N DIE,DA,DR
....S DIE=8925,DA=TIUCHILD,DR="2101///@" D ^DIE
....W !?5,"..... Removed pointer from child to parent."
....S ^TMP("TIU214",$J,"FIX_MISMATCH_PTR")=^TMP("TIU214",$J,"FIX_MISMATCH_PTR")+1
...I $G(^TIU(8925,TIUCHILD,21))'=TIUPRNT D
....K ^TIU(8925,"GDAD",TIUPRNT,TIUCHILD)
....W !?5,"..... Child note did not point to parent. GDAD cross reference removed."
....S ^TMP("TIU214",$J,"FIX_MISMATCH_XREF")=^TMP("TIU214",$J,"FIX_MISMATCH_XREF")+1
Q:TIUQUIT
I TIUDATA D PAUSE Q:TIUQUIT
S TIUDATA=0,TIULEN=$S(IOST["C-":9,1:7)
I TIUFIX S TIULEN=TIULEN+1
D HDR2(1)
S TIUPRNT=""
F S TIUPRNT=$O(^TMP("TIU214",$J,"MISSING",TIUPRNT)) Q:TIUPRNT=""!(TIUQUIT) D
.S TIUCHILD=""
.F S TIUCHILD=$O(^TMP("TIU214",$J,"MISSING",TIUPRNT,TIUCHILD)) Q:TIUCHILD=""!(TIUQUIT) D
..S TIUCINFO=^TMP("TIU214",$J,"MISSING",TIUPRNT,TIUCHILD)
..I $Y>(IOSL-TIULEN) D PAUSE Q:TIUQUIT D HDR2(1)
..W !!," Patient: " W:TIUSHOW $P(TIUCINFO,"^",1)," (" W $P(TIUCINFO,"^",2) W:TIUSHOW ")"
..W !," Title: ",$P(TIUCINFO,"^",3)
..W !," Entry DT: ",$P(TIUCINFO,"^",4)
..W !," Author: ",$P(TIUCINFO,"^",5)
..W !," Child IEN: ",TIUCHILD
..W !,"Parent IEN: ",TIUPRNT
..I TIUFIX D
...I $G(^TIU(8925,TIUCHILD,21))=TIUPRNT D Q
....N DIE,DA,DR
....S DIE=8925,DA=TIUCHILD,DR="2101///@" D ^DIE
....W !?5,"..... Removed pointer from child to parent."
....S ^TMP("TIU214",$J,"FIX_MISSING_PTR")=^TMP("TIU214",$J,"FIX_MISSING_PTR")+1
...I $G(^TIU(8925,TIUCHILD,21))'=TIUPRNT D
....K ^TIU(8925,"GDAD",TIUPRNT,TIUCHILD)
....W !?5,"..... Child note did not point to parent. GDAD cross reference removed."
....S ^TMP("TIU214",$J,"FIX_MISSING_XREF")=^TMP("TIU214",$J,"FIX_MISSING_XREF")+1
Q:TIUQUIT
I TIUDATA D PAUSE Q:TIUQUIT
S TIUDATA=0,TIULEN=$S(IOST["C-":9,1:7)
D HDR3(1)
S TIUPRNT=""
F S TIUPRNT=$O(^TMP("TIU214",$J,"NONPRNT",TIUPRNT)) Q:TIUPRNT=""!(TIUQUIT) D
.S TIUCHILD=""
.F S TIUCHILD=$O(^TMP("TIU214",$J,"NONPRNT",TIUPRNT,TIUCHILD)) Q:TIUCHILD=""!(TIUQUIT) D
..S TIUCINFO=^TMP("TIU214",$J,"NONPRNT",TIUPRNT,TIUCHILD)
..I $Y>(IOSL-TIULEN) D PAUSE Q:TIUQUIT D HDR3(1)
..W !!," Patient: " W:TIUSHOW $P(TIUCINFO,"^",1)," (" W $P(TIUCINFO,"^",2) W:TIUSHOW ")"
..W !," Parent Title: ",$P(TIUCINFO,"^",3),"-IEN: ",TIUPRNT
..W !,"Parent Entry DT: ",$P(TIUCINFO,"^",4)
..W !," Parent Author: ",$P(TIUCINFO,"^",5)
..W !," Child Title: ",$P(TIUCINFO,"^",7),"-IEN: ",TIUCHILD
Q:TIUQUIT
I TIUDATA D PAUSE Q:TIUQUIT
W !,@IOF
W !!?15,"TOTAL COUNTS FOR MISMATCHED ID NOTES"
W !?15,"------------------------------------",!
W !?15,+^TMP("TIU214",$J)_" CROSS REFERENCES CHECKED"
W !?15,+^TMP("TIU214",$J,"MISMATCH")_" MISSMATCHED NOTE(S) FOUND"
W !?15,+^TMP("TIU214",$J,"MISSING")_" NON EXISTENT PARENT NOTE(S)"
W !?15,+^TMP("TIU214",$J,"NONPRNT")_" PARENT MAY NOT BE AN ID NOTE"
I TIUFIX D
.W !!?15,+^TMP("TIU214",$J,"FIX_MISMATCH_PTR")_" POINTER(S) FIXED FOR MISMATCHED NOTES"
.W !?15,+^TMP("TIU214",$J,"FIX_MISMATCH_XREF")_" XREF(S) FIXED FOR MISMATCHED NOTES"
.W !?15,+^TMP("TIU214",$J,"FIX_MISSING_PTR")_" POINTER(S) FIXED FOR MISSING NOTES"
.W !?15,+^TMP("TIU214",$J,"FIX_MISSING_XREF")_" XREF(S) FIXED FOR MISSING NOTES"
Q
MAIL ; EMAIL TOTALS TO B.PSI-06-030 TO TRACK COMPLIANCE
N XMDUZ,XMSUBJ,XMTO,TIUMAIL,%H,Y
S XMDUZ="",XMSUBJ="MISMATCHED ID NOTES"
S TIUMAIL(1,0)=$P($$SITE^VASITE(),"^",1,2)
S %H=$H D YX^%DTC
S TIUMAIL(2,0)=Y
S TIUMAIL(3,0)=""
S TIUMAIL(4,0)=+^TMP("TIU214",$J)_" CROSS REFERENCES CHECKED"
S TIUMAIL(5,0)=+^TMP("TIU214",$J,"MISMATCH")_" MISS MATCHED NOTE(S) FOUND"
S TIUMAIL(6,0)=+^TMP("TIU214",$J,"MISSING")_" NON EXISTENT PARENT NOTE(S)"
I 'TIUFIX D
.S TIUMAIL(7,0)=""
.S TIUMAIL(8,0)="MODE - REPORT ONLY"
I TIUFIX D
.S TIUMAIL(7,0)=""
.S TIUMAIL(8,0)="MODE - REPORT AND FIX"
.S TIUMAIL(9,0)=+^TMP("TIU214",$J,"FIX_MISMATCH_PTR")_" POINTER(S) FIXED FOR MISMATCHED NOTES"
.S TIUMAIL(10,0)=+^TMP("TIU214",$J,"FIX_MISMATCH_XREF")_" XREF(S) FIXED FOR MISMATCHED NOTES"
.S TIUMAIL(11,0)=+^TMP("TIU214",$J,"FIX_MISSING_PTR")_" POINTER(S) FIXED FOR MISSING NOTES"
.S TIUMAIL(12,0)=+^TMP("TIU214",$J,"FIX_MISSING_XREF")_" XREF(S) FIXED FOR MISSING NOTES"
S XMTO("G.PSI-06-030@DOMAIN.EXT")=""
D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,"TIUMAIL",.XMTO)
Q
PNAME(PTDFN) ; Return Patient Name & last 4 of SSN
N TIUSSN,TIUSSN4,TIUNAME,TIUPN,VADM
I $G(PTDFN)="" Q "UNKNOWN^UNKNOWN"
;
S DFN=PTDFN D DEM^VADPT
S TIUSSN=$P(VADM(2),"^",2)
S TIUSSN4=$P(TIUSSN,"-",3)
S TIUPN=VADM(1)
I TIUPN'="" S TIUPN=TIUPN_"^"_$E(TIUPN)_TIUSSN4
I TIUPN="" S TIUPN="UNKNOWN^UNKNOWN"
Q TIUPN
HDR1(TIUFF) ;
Q:^TMP("TIU214",$J,"MISMATCH")=0
S TIUDATA=1
I TIUFF W @IOF
W ?18,"MISMATCHED INTERDISCIPLINARY NOTES"
W !!?10,"CHILD DOCUMENT",?45,"PARENT DOCUMENT"
W !?10,"---------------",?45,"--------------" Q
HDR2(TIUFF) ;
Q:^TMP("TIU214",$J,"MISSING")=0
S TIUDATA=1
I TIUFF W @IOF
W !?11,"CHILD ID NOTES POINTING TO A NON-EXISTENT PARENT ID NOTE" Q
HDR3(TIUFF) ;
Q:^TMP("TIU214",$J,"NONPRNT")=0
S TIUDATA=1
I TIUFF W @IOF
W !?11,"CHILD ID NOTES POINTING TO A PARENT THAT MAY NOT BE AN ID NOTE"
W !!?11,"** NOTE: THIS IS AN INFORMATIONAL LIST FOR INVESTIGATION.",!?11," NOTHING WILL BE FIXED **" Q
PAUSE ;
I IOST["C-" D
.N DIRUT,DIR
.W ! S DIR(0)="E" D ^DIR K DIR
.I $G(DIRUT)=1 S TIUQUIT=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIU214 9963 printed Apr 09, 2024@21:42:33 Page 2
TIU214 ; VMP/JML - ID NOTES with Mismatched Patients ;3/31/06 ; Compiled March 13, 2006 15:21:26
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**214**;Jun 20, 1997
+2 ; Report/Fix ID Documents where the child note points to a parent note for a different patient.
+3 ; Report only Documents where the child note points to a parent that may not be an id note.
+4 QUIT
EN ; Build array of mismatched ID documents
+1 NEW TIUPRNT,TIUCHILD,TIUPDFN,TIUCDFN,TIUPNAME,TIUCNAME,TIUP0,TIUC0,TIUCAUTH,TIUCTITL,TIUDATA,TIUBAD
+2 NEW TIUC12,TIUCEDT,TIUPAUTH,TIUPTITL,TIUP12,TIUPEDT,TIUFIX,Y,DFN,%ZIS,POP,DIR,DIRUT,TIULEN,TIUDUZ
+3 SET DIR(0)="SO^1:REPORT;2:FIX"
+4 SET DIR("L",1)="Report only or Report AND fix the bad pointers?"
+5 SET DIR("L",2)=""
+6 SET DIR("L",3)="1 - Report Only"
+7 SET DIR("L")="2 - Report and Fix"
+8 SET DIR("B")=1
+9 DO ^DIR
KILL DIR
+10 if $GET(DIRUT)
QUIT
+11 SET TIUFIX=$SELECT(Y=2:1,1:0)
SET TIUDUZ=$GET(DUZ)
+12 SET %ZIS="Q"
DO ^%ZIS
+13 if $GET(POP)>0
QUIT
+14 IF $GET(IO("Q"))=1
Begin DoDot:1
+15 NEW ZTRTN,ZTDESC,ZTSAVE
+16 SET ZTRTN="SEARCH^TIU214"
SET ZTDESC="Mismatched ID Note Report"
SET ZTSAVE("TIU*")=""
+17 DO ^%ZTLOAD
KILL IO("Q")
End DoDot:1
QUIT
SEARCH ;
+1 KILL ^TMP("TIU214",$JOB)
+2 SET ^TMP("TIU214",$JOB)=0
SET ^TMP("TIU214",$JOB,"MISMATCH")=0
SET ^TMP("TIU214",$JOB,"MISSING")=0
SET ^TMP("TIU214",$JOB,"NONPRNT")=0
+3 IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF,!!?5,"Searching for Parent/Child ID Notes with mismatched patients...",!!
+4 SET TIUPRNT=0
+5 FOR
SET TIUPRNT=$ORDER(^TIU(8925,"GDAD",TIUPRNT))
if TIUPRNT=""
QUIT
Begin DoDot:1
+6 SET ^TMP("TIU214",$JOB)=^TMP("TIU214",$JOB)+1
+7 SET TIUCHILD=0
+8 FOR
SET TIUCHILD=+$ORDER(^TIU(8925,"GDAD",TIUPRNT,TIUCHILD))
if 'TIUCHILD
QUIT
Begin DoDot:2
+9 SET TIUC0=$GET(^TIU(8925,TIUCHILD,0))
SET TIUCDFN=$PIECE(TIUC0,U,2)
+10 SET TIUCNAME=$$PNAME(TIUCDFN)
+11 SET TIUCAUTH=$$GET1^DIQ(8925,TIUCHILD_",",1202)
+12 SET TIUCTITL=$$GET1^DIQ(8925,TIUCHILD_",",.01)
+13 SET TIUC12=$GET(^TIU(8925,TIUCHILD,12))
+14 SET Y=$PIECE(TIUC12,"^")
DO DD^%DT
SET TIUCEDT=Y
+15 SET TIUP0=$GET(^TIU(8925,TIUPRNT,0))
SET TIUPDFN=$PIECE(TIUP0,U,2)
+16 IF TIUP0=""
Begin DoDot:3
+17 SET ^TMP("TIU214",$JOB,"MISSING")=^TMP("TIU214",$JOB,"MISSING")+1
+18 SET ^TMP("TIU214",$JOB,"MISSING",TIUPRNT,TIUCHILD)=TIUCNAME_"^"_TIUCTITL_"^"_TIUCEDT_"^"_TIUCAUTH
End DoDot:3
QUIT
+19 IF TIUPDFN'=TIUCDFN
Begin DoDot:3
+20 SET TIUPNAME=$$PNAME(TIUPDFN)
+21 SET ^TMP("TIU214",$JOB,"MISMATCH")=^TMP("TIU214",$JOB,"MISMATCH")+1
+22 IF '$DATA(^TMP("TIU214",$JOB,"MISMATCH",TIUPRNT))
Begin DoDot:4
+23 SET TIUPAUTH=$$GET1^DIQ(8925,TIUPRNT_",",1202)
+24 SET TIUPTITL=$$GET1^DIQ(8925,TIUPRNT_",",.01)
+25 SET TIUP12=$GET(^TIU(8925,TIUPRNT,12))
+26 SET Y=$PIECE(TIUP12,"^")
DO DD^%DT
SET TIUPEDT=Y
+27 SET ^TMP("TIU214",$JOB,"MISMATCH",TIUPRNT)=TIUPNAME_"^"_TIUPTITL_"^"_TIUPEDT_"^"_TIUPAUTH_"^"_TIUPRNT
End DoDot:4
+28 SET ^TMP("TIU214",$JOB,"MISMATCH",TIUPRNT,TIUCHILD)=TIUCNAME_"^"_TIUCTITL_"^"_TIUCEDT_"^"_TIUCAUTH_"^"_TIUCHILD
End DoDot:3
QUIT
+29 SET TIUBAD=""
SET TIUBAD=$$POSSPRNT^TIULP(+TIUP0)
IF '+TIUBAD
Begin DoDot:3
+30 SET ^TMP("TIU214",$JOB,"NONPRNT")=^TMP("TIU214",$JOB,"NONPRNT")+1
+31 SET TIUPAUTH=$$GET1^DIQ(8925,TIUPRNT_",",1202)
+32 SET TIUPTITL=$$GET1^DIQ(8925,TIUPRNT_",",.01)
+33 SET TIUP12=$GET(^TIU(8925,TIUPRNT,12))
+34 SET Y=$PIECE(TIUP12,"^")
DO DD^%DT
SET TIUPEDT=Y
+35 SET ^TMP("TIU214",$JOB,"NONPRNT",TIUPRNT,TIUCHILD)=TIUCNAME_"^"_TIUPTITL_"^"_TIUPEDT_"^"_TIUPAUTH_"^"_TIUPRNT_"^"_TIUCTITL
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+36 DO REPORT
+37 DO MAIL
+38 KILL ^TMP("TIU214",$JOB)
+39 DO ^%ZISC
+40 QUIT
REPORT ;
+1 USE IO
+2 NEW TIUQUIT,TIUHIDE,TIUCINFO,TIUPINFO,TIUSHOW
+3 SET TIUQUIT=0
SET TIUSHOW=$SELECT(IOST["P-":0,1:1)
+4 SET ^TMP("TIU214",$JOB,"FIX_MISMATCH_PTR")=0
SET ^TMP("TIU214",$JOB,"FIX_MISMATCH_XREF")=0
+5 SET ^TMP("TIU214",$JOB,"FIX_MISSING_PTR")=0
SET ^TMP("TIU214",$JOB,"FIX_MISSING_XREF")=0
+6 IF IOST["C-"
DO CLEAR^VALM1
+7 SET TIUDATA=0
SET TIULEN=$SELECT(IOST["C-":8,1:6)
+8 IF TIUFIX
SET TIULEN=TIULEN+1
+9 DO HDR1(0)
+10 SET TIUPRNT=""
+11 FOR
SET TIUPRNT=$ORDER(^TMP("TIU214",$JOB,"MISMATCH",TIUPRNT))
if TIUPRNT=""!(TIUQUIT)
QUIT
Begin DoDot:1
+12 SET TIUPINFO=$GET(^TMP("TIU214",$JOB,"MISMATCH",TIUPRNT))
+13 SET TIUCHILD=""
+14 FOR
SET TIUCHILD=$ORDER(^TMP("TIU214",$JOB,"MISMATCH",TIUPRNT,TIUCHILD))
if TIUCHILD=""!(TIUQUIT)
QUIT
Begin DoDot:2
+15 SET TIUCINFO=$GET(^TMP("TIU214",$JOB,"MISMATCH",TIUPRNT,TIUCHILD))
+16 IF $Y>(IOSL-TIULEN)
DO PAUSE
if TIUQUIT
QUIT
DO HDR1(1)
+17 IF TIUSHOW
Begin DoDot:3
+18 WRITE !!," Patient: ",$EXTRACT($PIECE(TIUCINFO,"^",1),1,26)," (",$PIECE(TIUCINFO,"^",2),")"
+19 WRITE ?45,$EXTRACT($PIECE(TIUPINFO,"^",1),1,26)," (",$PIECE(TIUPINFO,"^",2),")"
End DoDot:3
+20 IF 'TIUSHOW
Begin DoDot:3
+21 WRITE !!," Patient: ",$PIECE(TIUCINFO,"^",2)
+22 WRITE ?45,$PIECE(TIUPINFO,"^",2)
End DoDot:3
+23 WRITE !," Title: ",$EXTRACT($PIECE(TIUCINFO,"^",3),1,33),?45,$EXTRACT($PIECE(TIUPINFO,"^",3),1,33)
+24 WRITE !,"Entry DT: ",$EXTRACT($PIECE(TIUCINFO,"^",4),1,33),?45,$EXTRACT($PIECE(TIUPINFO,"^",4),1,33)
+25 WRITE !," Author: ",$EXTRACT($PIECE(TIUCINFO,"^",5),1,33),?45,$EXTRACT($PIECE(TIUPINFO,"^",5),1,33)
+26 WRITE !,"Note IEN: ",$EXTRACT($PIECE(TIUCINFO,"^",6),1,33),?45,$EXTRACT($PIECE(TIUPINFO,"^",6),1,33)
+27 IF TIUFIX
Begin DoDot:3
+28 IF $GET(^TIU(8925,TIUCHILD,21))=TIUPRNT
Begin DoDot:4
+29 NEW DIE,DA,DR
+30 SET DIE=8925
SET DA=TIUCHILD
SET DR="2101///@"
DO ^DIE
+31 WRITE !?5,"..... Removed pointer from child to parent."
+32 SET ^TMP("TIU214",$JOB,"FIX_MISMATCH_PTR")=^TMP("TIU214",$JOB,"FIX_MISMATCH_PTR")+1
End DoDot:4
QUIT
+33 IF $GET(^TIU(8925,TIUCHILD,21))'=TIUPRNT
Begin DoDot:4
+34 KILL ^TIU(8925,"GDAD",TIUPRNT,TIUCHILD)
+35 WRITE !?5,"..... Child note did not point to parent. GDAD cross reference removed."
+36 SET ^TMP("TIU214",$JOB,"FIX_MISMATCH_XREF")=^TMP("TIU214",$JOB,"FIX_MISMATCH_XREF")+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+37 if TIUQUIT
QUIT
+38 IF TIUDATA
DO PAUSE
if TIUQUIT
QUIT
+39 SET TIUDATA=0
SET TIULEN=$SELECT(IOST["C-":9,1:7)
+40 IF TIUFIX
SET TIULEN=TIULEN+1
+41 DO HDR2(1)
+42 SET TIUPRNT=""
+43 FOR
SET TIUPRNT=$ORDER(^TMP("TIU214",$JOB,"MISSING",TIUPRNT))
if TIUPRNT=""!(TIUQUIT)
QUIT
Begin DoDot:1
+44 SET TIUCHILD=""
+45 FOR
SET TIUCHILD=$ORDER(^TMP("TIU214",$JOB,"MISSING",TIUPRNT,TIUCHILD))
if TIUCHILD=""!(TIUQUIT)
QUIT
Begin DoDot:2
+46 SET TIUCINFO=^TMP("TIU214",$JOB,"MISSING",TIUPRNT,TIUCHILD)
+47 IF $Y>(IOSL-TIULEN)
DO PAUSE
if TIUQUIT
QUIT
DO HDR2(1)
+48 WRITE !!," Patient: "
if TIUSHOW
WRITE $PIECE(TIUCINFO,"^",1)," ("
WRITE $PIECE(TIUCINFO,"^",2)
if TIUSHOW
WRITE ")"
+49 WRITE !," Title: ",$PIECE(TIUCINFO,"^",3)
+50 WRITE !," Entry DT: ",$PIECE(TIUCINFO,"^",4)
+51 WRITE !," Author: ",$PIECE(TIUCINFO,"^",5)
+52 WRITE !," Child IEN: ",TIUCHILD
+53 WRITE !,"Parent IEN: ",TIUPRNT
+54 IF TIUFIX
Begin DoDot:3
+55 IF $GET(^TIU(8925,TIUCHILD,21))=TIUPRNT
Begin DoDot:4
+56 NEW DIE,DA,DR
+57 SET DIE=8925
SET DA=TIUCHILD
SET DR="2101///@"
DO ^DIE
+58 WRITE !?5,"..... Removed pointer from child to parent."
+59 SET ^TMP("TIU214",$JOB,"FIX_MISSING_PTR")=^TMP("TIU214",$JOB,"FIX_MISSING_PTR")+1
End DoDot:4
QUIT
+60 IF $GET(^TIU(8925,TIUCHILD,21))'=TIUPRNT
Begin DoDot:4
+61 KILL ^TIU(8925,"GDAD",TIUPRNT,TIUCHILD)
+62 WRITE !?5,"..... Child note did not point to parent. GDAD cross reference removed."
+63 SET ^TMP("TIU214",$JOB,"FIX_MISSING_XREF")=^TMP("TIU214",$JOB,"FIX_MISSING_XREF")+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+64 if TIUQUIT
QUIT
+65 IF TIUDATA
DO PAUSE
if TIUQUIT
QUIT
+66 SET TIUDATA=0
SET TIULEN=$SELECT(IOST["C-":9,1:7)
+67 DO HDR3(1)
+68 SET TIUPRNT=""
+69 FOR
SET TIUPRNT=$ORDER(^TMP("TIU214",$JOB,"NONPRNT",TIUPRNT))
if TIUPRNT=""!(TIUQUIT)
QUIT
Begin DoDot:1
+70 SET TIUCHILD=""
+71 FOR
SET TIUCHILD=$ORDER(^TMP("TIU214",$JOB,"NONPRNT",TIUPRNT,TIUCHILD))
if TIUCHILD=""!(TIUQUIT)
QUIT
Begin DoDot:2
+72 SET TIUCINFO=^TMP("TIU214",$JOB,"NONPRNT",TIUPRNT,TIUCHILD)
+73 IF $Y>(IOSL-TIULEN)
DO PAUSE
if TIUQUIT
QUIT
DO HDR3(1)
+74 WRITE !!," Patient: "
if TIUSHOW
WRITE $PIECE(TIUCINFO,"^",1)," ("
WRITE $PIECE(TIUCINFO,"^",2)
if TIUSHOW
WRITE ")"
+75 WRITE !," Parent Title: ",$PIECE(TIUCINFO,"^",3),"-IEN: ",TIUPRNT
+76 WRITE !,"Parent Entry DT: ",$PIECE(TIUCINFO,"^",4)
+77 WRITE !," Parent Author: ",$PIECE(TIUCINFO,"^",5)
+78 WRITE !," Child Title: ",$PIECE(TIUCINFO,"^",7),"-IEN: ",TIUCHILD
End DoDot:2
End DoDot:1
+79 if TIUQUIT
QUIT
+80 IF TIUDATA
DO PAUSE
if TIUQUIT
QUIT
+81 WRITE !,@IOF
+82 WRITE !!?15,"TOTAL COUNTS FOR MISMATCHED ID NOTES"
+83 WRITE !?15,"------------------------------------",!
+84 WRITE !?15,+^TMP("TIU214",$JOB)_" CROSS REFERENCES CHECKED"
+85 WRITE !?15,+^TMP("TIU214",$JOB,"MISMATCH")_" MISSMATCHED NOTE(S) FOUND"
+86 WRITE !?15,+^TMP("TIU214",$JOB,"MISSING")_" NON EXISTENT PARENT NOTE(S)"
+87 WRITE !?15,+^TMP("TIU214",$JOB,"NONPRNT")_" PARENT MAY NOT BE AN ID NOTE"
+88 IF TIUFIX
Begin DoDot:1
+89 WRITE !!?15,+^TMP("TIU214",$JOB,"FIX_MISMATCH_PTR")_" POINTER(S) FIXED FOR MISMATCHED NOTES"
+90 WRITE !?15,+^TMP("TIU214",$JOB,"FIX_MISMATCH_XREF")_" XREF(S) FIXED FOR MISMATCHED NOTES"
+91 WRITE !?15,+^TMP("TIU214",$JOB,"FIX_MISSING_PTR")_" POINTER(S) FIXED FOR MISSING NOTES"
+92 WRITE !?15,+^TMP("TIU214",$JOB,"FIX_MISSING_XREF")_" XREF(S) FIXED FOR MISSING NOTES"
End DoDot:1
+93 QUIT
MAIL ; EMAIL TOTALS TO B.PSI-06-030 TO TRACK COMPLIANCE
+1 NEW XMDUZ,XMSUBJ,XMTO,TIUMAIL,%H,Y
+2 SET XMDUZ=""
SET XMSUBJ="MISMATCHED ID NOTES"
+3 SET TIUMAIL(1,0)=$PIECE($$SITE^VASITE(),"^",1,2)
+4 SET %H=$HOROLOG
DO YX^%DTC
+5 SET TIUMAIL(2,0)=Y
+6 SET TIUMAIL(3,0)=""
+7 SET TIUMAIL(4,0)=+^TMP("TIU214",$JOB)_" CROSS REFERENCES CHECKED"
+8 SET TIUMAIL(5,0)=+^TMP("TIU214",$JOB,"MISMATCH")_" MISS MATCHED NOTE(S) FOUND"
+9 SET TIUMAIL(6,0)=+^TMP("TIU214",$JOB,"MISSING")_" NON EXISTENT PARENT NOTE(S)"
+10 IF 'TIUFIX
Begin DoDot:1
+11 SET TIUMAIL(7,0)=""
+12 SET TIUMAIL(8,0)="MODE - REPORT ONLY"
End DoDot:1
+13 IF TIUFIX
Begin DoDot:1
+14 SET TIUMAIL(7,0)=""
+15 SET TIUMAIL(8,0)="MODE - REPORT AND FIX"
+16 SET TIUMAIL(9,0)=+^TMP("TIU214",$JOB,"FIX_MISMATCH_PTR")_" POINTER(S) FIXED FOR MISMATCHED NOTES"
+17 SET TIUMAIL(10,0)=+^TMP("TIU214",$JOB,"FIX_MISMATCH_XREF")_" XREF(S) FIXED FOR MISMATCHED NOTES"
+18 SET TIUMAIL(11,0)=+^TMP("TIU214",$JOB,"FIX_MISSING_PTR")_" POINTER(S) FIXED FOR MISSING NOTES"
+19 SET TIUMAIL(12,0)=+^TMP("TIU214",$JOB,"FIX_MISSING_XREF")_" XREF(S) FIXED FOR MISSING NOTES"
End DoDot:1
+20 SET XMTO("G.PSI-06-030@DOMAIN.EXT")=""
+21 DO SENDMSG^XMXAPI(XMDUZ,XMSUBJ,"TIUMAIL",.XMTO)
+22 QUIT
PNAME(PTDFN) ; Return Patient Name & last 4 of SSN
+1 NEW TIUSSN,TIUSSN4,TIUNAME,TIUPN,VADM
+2 IF $GET(PTDFN)=""
QUIT "UNKNOWN^UNKNOWN"
+3 ;
+4 SET DFN=PTDFN
DO DEM^VADPT
+5 SET TIUSSN=$PIECE(VADM(2),"^",2)
+6 SET TIUSSN4=$PIECE(TIUSSN,"-",3)
+7 SET TIUPN=VADM(1)
+8 IF TIUPN'=""
SET TIUPN=TIUPN_"^"_$EXTRACT(TIUPN)_TIUSSN4
+9 IF TIUPN=""
SET TIUPN="UNKNOWN^UNKNOWN"
+10 QUIT TIUPN
HDR1(TIUFF) ;
+1 if ^TMP("TIU214",$JOB,"MISMATCH")=0
QUIT
+2 SET TIUDATA=1
+3 IF TIUFF
WRITE @IOF
+4 WRITE ?18,"MISMATCHED INTERDISCIPLINARY NOTES"
+5 WRITE !!?10,"CHILD DOCUMENT",?45,"PARENT DOCUMENT"
+6 WRITE !?10,"---------------",?45,"--------------"
QUIT
HDR2(TIUFF) ;
+1 if ^TMP("TIU214",$JOB,"MISSING")=0
QUIT
+2 SET TIUDATA=1
+3 IF TIUFF
WRITE @IOF
+4 WRITE !?11,"CHILD ID NOTES POINTING TO A NON-EXISTENT PARENT ID NOTE"
QUIT
HDR3(TIUFF) ;
+1 if ^TMP("TIU214",$JOB,"NONPRNT")=0
QUIT
+2 SET TIUDATA=1
+3 IF TIUFF
WRITE @IOF
+4 WRITE !?11,"CHILD ID NOTES POINTING TO A PARENT THAT MAY NOT BE AN ID NOTE"
+5 WRITE !!?11,"** NOTE: THIS IS AN INFORMATIONAL LIST FOR INVESTIGATION.",!?11," NOTHING WILL BE FIXED **"
QUIT
PAUSE ;
+1 IF IOST["C-"
Begin DoDot:1
+2 NEW DIRUT,DIR
+3 WRITE !
SET DIR(0)="E"
DO ^DIR
KILL DIR
+4 IF $GET(DIRUT)=1
SET TIUQUIT=1
End DoDot:1
+5 QUIT
