TIUP149P ; SLC/JAK,RMO - Post-Install for TIU*1*149 Cont.;10/30/02@09:27:47
;;1.0;TEXT INTEGRATION UTILITIES;**149**;Jun 20, 1997
PRINT ; -- Device Selection
N EXNDBIF,TIUOUT
W !!,"This routine will print the results of the clean up routine in patch"
W !,"TIU*1*149 which provides a clean up for documents pointing to a different"
W !,"patient's visit in the TIU DOCUMENT file (#8925)."
;
;If integrated facility, ask about excluding NDBI fix needed records
I $$CHKINF^TIUP149,$$ASKEX(.TIUOUT) S EXNDBIF=1
G PRINTQ:$G(TIUOUT)
;
W !!,*7,"This report requires a column width of 132.",!
S %ZIS="Q" D ^%ZIS I POP K POP G PRINTQ
I $D(IO("Q")) K IO("Q") D Q
. I $G(EXNDBIF) S ZTSAVE("EXNDBIF")=""
. S ZTRTN="LIST^TIUP149P"
. S ZTDESC="TIU*1*149 - PRINT CLEAN-UP RESULTS"
. D ^%ZTLOAD W !,$S($D(ZTSK):"Request queued",1:"Request Cancelled!")
. K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,%ZIS
. D HOME^%ZIS
U IO D LIST,^%ZISC
PRINTQ Q
;
ASKEX(TIUOUT) ;Ask if user would like to exclude NDBI fix needed records
; Input -- None
; Output -- 1=Yes and 0=No
; TIUOUT Timeout or up-arow flag
N DIR,DTOUT,DUOUT,Y
S DIR("A")="Do you want to exclude 'NDBI Fix Needed' records from the report"
S DIR("B")="YES",DIR(0)="Y"
W ! D ^DIR
I $D(DTOUT)!($D(DUOUT)) S TIUOUT=1
Q +$G(Y)
;
LIST ; -- Entry point to generate list
N TIUDA,TIULNK,TIUOUT S TIUOUT=0
I $D(ZTQUEUED) S ZTREQ="@"
D HDR
I +$O(^XTMP("TIUP149","LNK",0))'>0 W !?4,"No records in list." G LISTQ
S TIUDA=0
F S TIUDA=$O(^XTMP("TIUP149","LNK",TIUDA)) Q:'TIUDA!(TIUOUT) S TIULNK=$G(^(TIUDA)) D LISTONE(TIUDA,TIULNK,$G(EXNDBIF))
LISTQ K EXNDBIF
Q
;
LISTONE(TIUDA,TIULNK,EXNDBIF) ;Entry point to list one record
; Input -- TIUDA TIU Document file (#8925) IEN
; TIULNK 1st piece= 1=Linked and 0=Not Linked
; 2nd piece= Exception type if not linked
; 3rd piece= Visit file (#9000010) IEN if linked
; EXNDBIF Exclude "NDBI Fix Needed" records flag (Optional)
; Output -- None
N DFN,TIUEX,VADM,VAIP,VAIN,VA
I $Y>(IOSL-4) D ASK G LISTONEQ:TIUOUT D HDR
S DFN=+$P($G(^TIU(8925,+TIUDA,0)),U,2)
S TIUEX=+$P($G(TIULNK),U,2)
;
;If exclude NDBI record flag set and NDBI record, exit
I $G(EXNDBIF),TIUEX=3 G LISTONEQ
D OERR^VADPT
W !,$E($G(VADM(1)),1,20)_" ("_$G(VA("BID"))_")"
W ?30,TIUDA
W ?42,$E($P($G(^TIU(8925.1,+$G(^TIU(8925,+TIUDA,0)),0)),U,1),1,15)
I +$G(TIULNK),$P(TIULNK,U,3) D
. N DA,DIC,DIQ,DR,TIUVISIT
. S DIC="^AUPNVSIT(",DIQ="TIUVISIT",DIQ(0)="E",DA=+$P(TIULNK,U,3)
. S DR=".01;.22" D EN^DIQ1
. W ?60,$G(TIUVISIT(9000010,DA,.01,"E"))
. W ?84,$E($G(TIUVISIT(9000010,DA,.22,"E")),1,20)
. W ?106,"Yes - Visit #"_$P(TIULNK,U,3)
ELSE D
. W ?106,"No - "
. W $S(TIUEX=1:"Entry in Use",TIUEX=2:"Unlinked Visit",TIUEX=3:"NDBI Fix Needed",1:"")
LISTONEQ Q
;
ASK ; -- End of Page
I IO=IO(0),$E(IOST)="C" D
. W ! N DIR,X,Y S DIR(0)="E"
. D ^DIR I $D(DUOUT)!$D(DTOUT) S TIUOUT=1
Q
;
HDR ; -- Header for report
N LNE,TIUNOW
D NOW^%DTC S Y=% X ^DD("DD") S TIUNOW=Y
W @IOF,"TIU*1*149 TIU DOCUMENTS LINKED TO A DIFFERENT PATIENT'S VISIT CLEAN-UP - Printed: ",TIUNOW
W !,"Patient",?30,"Document #",?42,"Title",?60,"Visit Date/Time",?84,"Hospital Location",?106,"Linked"
W ! S LNE="",$P(LNE,"-",(IOM-1))="" W LNE
Q
;
MAIL ;Send completion message to user who initiated post-install
N XMSUB,XMTEXT,XMDUZ,XMY,XMZ,XMMG
N TIURNG,TIUTXT
S XMDUZ="PATCH TIU*1*149 TIU DOCUMENT CLEAN-UP RESULTS",XMY(.5)=""
S:$G(DUZ) XMY(DUZ)=""
S XMY("G.PATIENT SAFETY NOTIFICATIONS")=""
S TIUTXT(1)="Clean up TIU Documents linked to a different patient's visit."
S TIUTXT(2)=""
S TIUTXT(3)="Task Started: "_$$FMTE^XLFDT($G(^XTMP("TIUP149","T0")))
S TIUTXT(4)="Task Ended: "_$$FMTE^XLFDT($G(^XTMP("TIUP149","T1")))
S TIUTXT(5)=""
;
S TIUTXT(6)="Number of entries linked to Correct Visit: "_+$G(^XTMP("TIUP149","CNT","LNK"))
S TIUTXT(7)=""
S TIUTXT(8)="Number of entries not corrected because Entry in Use: "_+$G(^XTMP("TIUP149","CNT","EX",1))
S TIUTXT(9)=""
S TIUTXT(10)="Number of entries unlinked from Incorrect Visit: "_+$G(^XTMP("TIUP149","CNT","EX",2))
S TIUTXT(11)=""
S TIUTXT(12)="TOTAL Number of entries processed: "_+$G(^XTMP("TIUP149","CNT","TOT"))
S TIUTXT(13)=""
I $G(^XTMP("TIUP149","STOP")) D
. S TIUTXT(14)="Task STOPPED: "_$$FMTE^XLFDT($G(^XTMP("TIUP149","STOP")))_"."
ELSE D
. S TIUTXT(14)="Task COMPLETED successfully."
. S TIUTXT(15)=""
. S TIUTXT(16)="To print a detailed listing of the clean up invoke D PRINT^TIUP149P."
;
I $G(NDBIF) D
. S TIUTXT(17)=""
. S TIUTXT(18)="SPECIAL NOTE FOR INTEGRATED FACILITIES:"
. S TIUTXT(19)=""
. S TIUTXT(20)="- Number of entries not corrected because NDBI Fix Needed: "_+$G(^XTMP("TIUP149","CNT","EX",3))
S XMTEXT="TIUTXT(",XMSUB="TIU*1*149 TIU Document Clean up for Different Patient's Visit"
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUP149P 4977 printed Sep 23, 2025@20:19:09 Page 2
TIUP149P ; SLC/JAK,RMO - Post-Install for TIU*1*149 Cont.;10/30/02@09:27:47
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**149**;Jun 20, 1997
PRINT ; -- Device Selection
+1 NEW EXNDBIF,TIUOUT
+2 WRITE !!,"This routine will print the results of the clean up routine in patch"
+3 WRITE !,"TIU*1*149 which provides a clean up for documents pointing to a different"
+4 WRITE !,"patient's visit in the TIU DOCUMENT file (#8925)."
+5 ;
+6 ;If integrated facility, ask about excluding NDBI fix needed records
+7 IF $$CHKINF^TIUP149
IF $$ASKEX(.TIUOUT)
SET EXNDBIF=1
+8 if $GET(TIUOUT)
GOTO PRINTQ
+9 ;
+10 WRITE !!,*7,"This report requires a column width of 132.",!
+11 SET %ZIS="Q"
DO ^%ZIS
IF POP
KILL POP
GOTO PRINTQ
+12 IF $DATA(IO("Q"))
KILL IO("Q")
Begin DoDot:1
+13 IF $GET(EXNDBIF)
SET ZTSAVE("EXNDBIF")=""
+14 SET ZTRTN="LIST^TIUP149P"
+15 SET ZTDESC="TIU*1*149 - PRINT CLEAN-UP RESULTS"
+16 DO ^%ZTLOAD
WRITE !,$SELECT($DATA(ZTSK):"Request queued",1:"Request Cancelled!")
+17 KILL ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,%ZIS
+18 DO HOME^%ZIS
End DoDot:1
QUIT
+19 USE IO
DO LIST
DO ^%ZISC
PRINTQ QUIT
+1 ;
ASKEX(TIUOUT) ;Ask if user would like to exclude NDBI fix needed records
+1 ; Input -- None
+2 ; Output -- 1=Yes and 0=No
+3 ; TIUOUT Timeout or up-arow flag
+4 NEW DIR,DTOUT,DUOUT,Y
+5 SET DIR("A")="Do you want to exclude 'NDBI Fix Needed' records from the report"
+6 SET DIR("B")="YES"
SET DIR(0)="Y"
+7 WRITE !
DO ^DIR
+8 IF $DATA(DTOUT)!($DATA(DUOUT))
SET TIUOUT=1
+9 QUIT +$GET(Y)
+10 ;
LIST ; -- Entry point to generate list
+1 NEW TIUDA,TIULNK,TIUOUT
SET TIUOUT=0
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 DO HDR
+4 IF +$ORDER(^XTMP("TIUP149","LNK",0))'>0
WRITE !?4,"No records in list."
GOTO LISTQ
+5 SET TIUDA=0
+6 FOR
SET TIUDA=$ORDER(^XTMP("TIUP149","LNK",TIUDA))
if 'TIUDA!(TIUOUT)
QUIT
SET TIULNK=$GET(^(TIUDA))
DO LISTONE(TIUDA,TIULNK,$GET(EXNDBIF))
LISTQ KILL EXNDBIF
+1 QUIT
+2 ;
LISTONE(TIUDA,TIULNK,EXNDBIF) ;Entry point to list one record
+1 ; Input -- TIUDA TIU Document file (#8925) IEN
+2 ; TIULNK 1st piece= 1=Linked and 0=Not Linked
+3 ; 2nd piece= Exception type if not linked
+4 ; 3rd piece= Visit file (#9000010) IEN if linked
+5 ; EXNDBIF Exclude "NDBI Fix Needed" records flag (Optional)
+6 ; Output -- None
+7 NEW DFN,TIUEX,VADM,VAIP,VAIN,VA
+8 IF $Y>(IOSL-4)
DO ASK
if TIUOUT
GOTO LISTONEQ
DO HDR
+9 SET DFN=+$PIECE($GET(^TIU(8925,+TIUDA,0)),U,2)
+10 SET TIUEX=+$PIECE($GET(TIULNK),U,2)
+11 ;
+12 ;If exclude NDBI record flag set and NDBI record, exit
+13 IF $GET(EXNDBIF)
IF TIUEX=3
GOTO LISTONEQ
+14 DO OERR^VADPT
+15 WRITE !,$EXTRACT($GET(VADM(1)),1,20)_" ("_$GET(VA("BID"))_")"
+16 WRITE ?30,TIUDA
+17 WRITE ?42,$EXTRACT($PIECE($GET(^TIU(8925.1,+$GET(^TIU(8925,+TIUDA,0)),0)),U,1),1,15)
+18 IF +$GET(TIULNK)
IF $PIECE(TIULNK,U,3)
Begin DoDot:1
+19 NEW DA,DIC,DIQ,DR,TIUVISIT
+20 SET DIC="^AUPNVSIT("
SET DIQ="TIUVISIT"
SET DIQ(0)="E"
SET DA=+$PIECE(TIULNK,U,3)
+21 SET DR=".01;.22"
DO EN^DIQ1
+22 WRITE ?60,$GET(TIUVISIT(9000010,DA,.01,"E"))
+23 WRITE ?84,$EXTRACT($GET(TIUVISIT(9000010,DA,.22,"E")),1,20)
+24 WRITE ?106,"Yes - Visit #"_$PIECE(TIULNK,U,3)
End DoDot:1
+25 IF '$TEST
Begin DoDot:1
+26 WRITE ?106,"No - "
+27 WRITE $SELECT(TIUEX=1:"Entry in Use",TIUEX=2:"Unlinked Visit",TIUEX=3:"NDBI Fix Needed",1:"")
End DoDot:1
LISTONEQ QUIT
+1 ;
ASK ; -- End of Page
+1 IF IO=IO(0)
IF $EXTRACT(IOST)="C"
Begin DoDot:1
+2 WRITE !
NEW DIR,X,Y
SET DIR(0)="E"
+3 DO ^DIR
IF $DATA(DUOUT)!$DATA(DTOUT)
SET TIUOUT=1
End DoDot:1
+4 QUIT
+5 ;
HDR ; -- Header for report
+1 NEW LNE,TIUNOW
+2 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET TIUNOW=Y
+3 WRITE @IOF,"TIU*1*149 TIU DOCUMENTS LINKED TO A DIFFERENT PATIENT'S VISIT CLEAN-UP - Printed: ",TIUNOW
+4 WRITE !,"Patient",?30,"Document #",?42,"Title",?60,"Visit Date/Time",?84,"Hospital Location",?106,"Linked"
+5 WRITE !
SET LNE=""
SET $PIECE(LNE,"-",(IOM-1))=""
WRITE LNE
+6 QUIT
+7 ;
MAIL ;Send completion message to user who initiated post-install
+1 NEW XMSUB,XMTEXT,XMDUZ,XMY,XMZ,XMMG
+2 NEW TIURNG,TIUTXT
+3 SET XMDUZ="PATCH TIU*1*149 TIU DOCUMENT CLEAN-UP RESULTS"
SET XMY(.5)=""
+4 if $GET(DUZ)
SET XMY(DUZ)=""
+5 SET XMY("G.PATIENT SAFETY NOTIFICATIONS")=""
+6 SET TIUTXT(1)="Clean up TIU Documents linked to a different patient's visit."
+7 SET TIUTXT(2)=""
+8 SET TIUTXT(3)="Task Started: "_$$FMTE^XLFDT($GET(^XTMP("TIUP149","T0")))
+9 SET TIUTXT(4)="Task Ended: "_$$FMTE^XLFDT($GET(^XTMP("TIUP149","T1")))
+10 SET TIUTXT(5)=""
+11 ;
+12 SET TIUTXT(6)="Number of entries linked to Correct Visit: "_+$GET(^XTMP("TIUP149","CNT","LNK"))
+13 SET TIUTXT(7)=""
+14 SET TIUTXT(8)="Number of entries not corrected because Entry in Use: "_+$GET(^XTMP("TIUP149","CNT","EX",1))
+15 SET TIUTXT(9)=""
+16 SET TIUTXT(10)="Number of entries unlinked from Incorrect Visit: "_+$GET(^XTMP("TIUP149","CNT","EX",2))
+17 SET TIUTXT(11)=""
+18 SET TIUTXT(12)="TOTAL Number of entries processed: "_+$GET(^XTMP("TIUP149","CNT","TOT"))
+19 SET TIUTXT(13)=""
+20 IF $GET(^XTMP("TIUP149","STOP"))
Begin DoDot:1
+21 SET TIUTXT(14)="Task STOPPED: "_$$FMTE^XLFDT($GET(^XTMP("TIUP149","STOP")))_"."
End DoDot:1
+22 IF '$TEST
Begin DoDot:1
+23 SET TIUTXT(14)="Task COMPLETED successfully."
+24 SET TIUTXT(15)=""
+25 SET TIUTXT(16)="To print a detailed listing of the clean up invoke D PRINT^TIUP149P."
End DoDot:1
+26 ;
+27 IF $GET(NDBIF)
Begin DoDot:1
+28 SET TIUTXT(17)=""
+29 SET TIUTXT(18)="SPECIAL NOTE FOR INTEGRATED FACILITIES:"
+30 SET TIUTXT(19)=""
+31 SET TIUTXT(20)="- Number of entries not corrected because NDBI Fix Needed: "_+$GET(^XTMP("TIUP149","CNT","EX",3))
End DoDot:1
+32 SET XMTEXT="TIUTXT("
SET XMSUB="TIU*1*149 TIU Document Clean up for Different Patient's Visit"
+33 DO ^XMD
+34 QUIT
