- 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 Mar 13, 2025@21:43:22 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
