TIUADCL1 ; SLC/AJB - UNK Addenda Cleanup ; 10/01/04
;;1.0;TEXT INTEGRATION UTILITIES;**173**;Jun 20, 1997
;
; Cleanup Utility for OPERATION REPORT addenda.
; Finds parentless/unknown addenda and attaches to user
; selected parent.
;
Q
EN ; main entry point for TIU UNK ADDENDA CLEANUP
N DTR2,TIUADD,TIULVL,TIUQUIT
D SAVEADD
D DTRANGE^TIUADCL(.DTR2) Q:$D(TIUQUIT)
D EN^VALM("TIU UNK ADDENDA ATTACH")
K ^TMP("VALMAR",$J,TIULVL)
Q
EXIT ;
D XQORM
Q
HDR ; sets header
N HDR
S HDR="OPERATION REPORTS from "_$$FMTE^XLFDT(DTR2("BEGDT"),"D")_" to "_$$FMTE^XLFDT(DTR2("ENDDT"),"D")
S VALMHDR(1)=$$SETSTR^VALM1(HDR,"",(IOM-$L(HDR))/2,$L(HDR))
D XQORM
Q
HELP ; help code
N DIR
I X="?" S DIR("A")="Enter RETURN to continue or '^' to exit",DIR(0)="E"
D FULL^VALM1
W !!,"The following actions are available:"
W !,"Browse a Document - View a selected document (if authorized)"
W !,"Change View - Modify search criteria"
W !,"Detailed Display - View detailed display of a document (if authorized)"
W !,"Attach to Parent - Attach the currently selected "
W $S($$MULTI^TIUADCL("TIUADD")>1:"addenda",1:"addendum")," to one OPERATION"
W !," REPORT",!
I $D(DIR("A")) D ^DIR
S VALMBCK="R"
Q
INIT ; finds unknown addenda & creates list
N OPREPORT,STRTDT,TIUDA,TIU
S TIULVL=VALMEVL,TIU("IOCUOFF")=$C(27)_"[?25l",TIU("IOCUON")=$C(27)_"[?25h"
W TIU("IOCUOFF")
W !!,"Searching for the documents."
S OPREPORT=$$CHKFILE^TIUADCL(8925.1,"OPERATION REPORT","I $P(^(0),U,4)=""DOC"""),TIUDA="",STRTDT=DTR2("BEGDT"),VALMCNT=0
F S STRTDT=$O(^TIU(8925,"F",STRTDT)) Q:STRTDT=""!(STRTDT>DTR2("ENDDT")) F S TIUDA=$O(^TIU(8925,"F",STRTDT,TIUDA)) Q:TIUDA="" I +$G(^TIU(8925,TIUDA,0))=OPREPORT D
. N DATA,DISPLAY,MSG
. I '$D(TIUADD($$GET1^DIQ(8925,TIUDA,.02))) Q
. ; D CANDO^TIUSRVA(.MSG,TIUDA,"MAKE ADDENDUM") I '+MSG Q
. S VALMCNT=VALMCNT+1 W:VALMCNT#3=0 "."
. S DISPLAY=$$SETSTR^VALM1(VALMCNT,"",1,4)
. S DISPLAY=$$SETSTR^VALM1($$PATIENT^TIU144($P($G(^TIU(8925,TIUDA,0)),U,2)),DISPLAY,6,38)
. S DISPLAY=$$SETSTR^VALM1(TIUDA,DISPLAY,40,50)
. S DISPLAY=$$SETSTR^VALM1($$FDATE^VALM1($$GET1^DIQ(8925,TIUDA,1201,"I")),DISPLAY,52,62)
. S DISPLAY=$$SETSTR^VALM1($$GET1^DIQ(8925,TIUDA,.05),DISPLAY,62,71)
. S DISPLAY=$$SETSTR^VALM1("#"_+$P($G(^TIU(8925,TIUDA,14)),U,5),DISPLAY,75,80)
. D SET^VALM10(VALMCNT,DISPLAY,TIUDA)
I VALMCNT=0 D
. D SET^VALM10(2,$$SETSTR^VALM1("No records found to satisfy search criteria.","",(IOM-$L("No records found to satisfy search criteria."))/2,$L("No records found to satisfy search criteria.")),0)
Q
XQORM ; default action for list manager
S XQORM("#")=$O(^ORD(101,"B","TIU UNK ADDENDA SELECT",0))_U_"1:"_VALMCNT
Q
ATTACH ;
N DISPLAY,LINE,PARENT
D FULL^VALM1 W @IOF
W "Attach the following UNKNOWN "_$S($$MULTI^TIUADCL("TIUADD")>1:"Addenda",1:"Addendum")_":",!!
W "TIU",!,"Doc No.",?9,"Patient",?40,"Entry DT/Time",?59,"Status",?71,"Parent",!
S LINE="",PARENT=$$ONEDOC^TIUADCL()
S $P(LINE,"-",80)="-" W LINE
S TIUADD="" F S TIUADD=$O(TIUADD(TIUADD)) Q:TIUADD=""!(+TIUADD'>0) D
. N TIUDA
. S TIUDA=TIUADD(TIUADD)
. S DISPLAY=$$SETSTR^VALM1(TIUDA,"",1,8)
. S DISPLAY=$$SETSTR^VALM1($$PATIENT^TIU144($P($G(^TIU(8925,TIUDA,0)),U,2)),DISPLAY,10,40)
. S DISPLAY=$$SETSTR^VALM1($$FDTTM^VALM1($$GET1^DIQ(8925,TIUDA,1201,"I")),DISPLAY,41,51)
. S DISPLAY=$$SETSTR^VALM1($$GET1^DIQ(8925,TIUDA,.05),DISPLAY,60,67)
. S DISPLAY=$$SETSTR^VALM1($S($$GET1^DIQ(8925,TIUDA,.06)="":"None",1:$$GET1^DIQ(8925,TIUDA,.06)),DISPLAY,72,80)
. W $E(DISPLAY,1,80)
W !!,"to the following "_$$GET1^DIQ(8925,PARENT,.01)_"?",!
S DISPLAY=$$SETSTR^VALM1(PARENT,"",1,8)
S DISPLAY=$$SETSTR^VALM1($$PATIENT^TIU144($P($G(^TIU(8925,PARENT,0)),U,2)),DISPLAY,10,40)
S DISPLAY=$$SETSTR^VALM1($$FDTTM^VALM1($$GET1^DIQ(8925,PARENT,1201,"I")),DISPLAY,41,51)
S DISPLAY=$$SETSTR^VALM1($$GET1^DIQ(8925,PARENT,.05),DISPLAY,60,67)
S DISPLAY=$$SETSTR^VALM1("#"_+$P($G(^TIU(8925,PARENT,14)),U,5),DISPLAY,72,80)
W !,"TIU",?71,"Surgical",!,"Doc No.",?9,"Patient",?40,"Entry DT/Time",?59,"Status",?71,"Case No.",!
W LINE,$E(DISPLAY,1,80),!
S VALMBCK="R"
I '$$READ^TIUU("Y","Do you wish to begin attaching","NO","Enter 'Y' or 'N'") W ! I $$READ^TIUU("EA","Press <RETURN> to continue") Q
S VALMBCK="Q"
S TIUADD="" F S TIUADD=$O(TIUADD(TIUADD)) Q:TIUADD=""!(+TIUADD'>0) D
. N TIUDA
. S TIUDA=TIUADD(TIUADD)
. W !!,"Attaching #",TIUDA," to #",PARENT," ... "
. D ATNOW(PARENT,TIUDA)
W ! I $$READ^TIUU("EA","Press <RETURN> to continue")
Q
ATNOW(PARENT,ADDENDUM) ;
N FDA,FDARR,IENS,FLAGS,TIUMSG,TIUA0,TIUA12,TIUP0,TIUP12,TIUWARN
S TIUP0=$G(^TIU(8925,PARENT,0)),TIUA0=$G(^TIU(8925,ADDENDUM,0))
S TIUP12=$G(^TIU(8925,PARENT,12)),TIUA12=$G(^TIU(8925,ADDENDUM,12))
I $P(TIUP0,U,2)'=$P(TIUA0,U,2) W !,"ERROR: Parent and Addendum have different patients!" S TIUWARN=1
I $P(TIUA12,U)'>$P(TIUP12,U) W !,"ERROR: The addendum's ENTRY DATE/TIME precedes the parent's ENTRY DATE/TIME!" S TIUWARN=1
I +$G(TIUWARN) Q
S IENS=""""_ADDENDUM_",""",FDARR="FDA(8925,"_IENS_")",FLAGS="K"
S @FDARR@(.06)=PARENT
S @FDARR@(1405)=$$GET1^DIQ(8925,PARENT,1405,"I")
D FILE^DIE(FLAGS,"FDA","TIUMSG")
I $D(TIUMSG) D Q
. N LINE S LINE=""
. F S LINE=$O(TIUMSG("DIERR",1,"TEXT",LINE)) Q:LINE="" W !,TIUMSG("DIERR",1,"TEXT",LINE)
W ?29," success!"
Q
SAVEADD ;
S TIUADD=0
F S TIUADD=$O(TIUDOCS(TIUADD)) Q:TIUADD="" S TIUADD(TIUADD)=TIUDOCS(TIUADD),TIUADD($$GET1^DIQ(8925,TIUADD(TIUADD),.02))=""
Q
PREP ;
N DA,DIC,DIK,X,Y
S DIC="^SD(409.61,",DIC(0)="X"
F X="TIU UNK ADDENDA ATTACH","TIU UNK ADDENDA CLEANUP" D
. D ^DIC I +Y D
.. S DA=+Y,DIK=DIC D ^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUADCL1 5723 printed Oct 16, 2024@18:39:22 Page 2
TIUADCL1 ; SLC/AJB - UNK Addenda Cleanup ; 10/01/04
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**173**;Jun 20, 1997
+2 ;
+3 ; Cleanup Utility for OPERATION REPORT addenda.
+4 ; Finds parentless/unknown addenda and attaches to user
+5 ; selected parent.
+6 ;
+7 QUIT
EN ; main entry point for TIU UNK ADDENDA CLEANUP
+1 NEW DTR2,TIUADD,TIULVL,TIUQUIT
+2 DO SAVEADD
+3 DO DTRANGE^TIUADCL(.DTR2)
if $DATA(TIUQUIT)
QUIT
+4 DO EN^VALM("TIU UNK ADDENDA ATTACH")
+5 KILL ^TMP("VALMAR",$JOB,TIULVL)
+6 QUIT
EXIT ;
+1 DO XQORM
+2 QUIT
HDR ; sets header
+1 NEW HDR
+2 SET HDR="OPERATION REPORTS from "_$$FMTE^XLFDT(DTR2("BEGDT"),"D")_" to "_$$FMTE^XLFDT(DTR2("ENDDT"),"D")
+3 SET VALMHDR(1)=$$SETSTR^VALM1(HDR,"",(IOM-$LENGTH(HDR))/2,$LENGTH(HDR))
+4 DO XQORM
+5 QUIT
HELP ; help code
+1 NEW DIR
+2 IF X="?"
SET DIR("A")="Enter RETURN to continue or '^' to exit"
SET DIR(0)="E"
+3 DO FULL^VALM1
+4 WRITE !!,"The following actions are available:"
+5 WRITE !,"Browse a Document - View a selected document (if authorized)"
+6 WRITE !,"Change View - Modify search criteria"
+7 WRITE !,"Detailed Display - View detailed display of a document (if authorized)"
+8 WRITE !,"Attach to Parent - Attach the currently selected "
+9 WRITE $SELECT($$MULTI^TIUADCL("TIUADD")>1:"addenda",1:"addendum")," to one OPERATION"
+10 WRITE !," REPORT",!
+11 IF $DATA(DIR("A"))
DO ^DIR
+12 SET VALMBCK="R"
+13 QUIT
INIT ; finds unknown addenda & creates list
+1 NEW OPREPORT,STRTDT,TIUDA,TIU
+2 SET TIULVL=VALMEVL
SET TIU("IOCUOFF")=$CHAR(27)_"[?25l"
SET TIU("IOCUON")=$CHAR(27)_"[?25h"
+3 WRITE TIU("IOCUOFF")
+4 WRITE !!,"Searching for the documents."
+5 SET OPREPORT=$$CHKFILE^TIUADCL(8925.1,"OPERATION REPORT","I $P(^(0),U,4)=""DOC""")
SET TIUDA=""
SET STRTDT=DTR2("BEGDT")
SET VALMCNT=0
+6 FOR
SET STRTDT=$ORDER(^TIU(8925,"F",STRTDT))
if STRTDT=""!(STRTDT>DTR2("ENDDT"))
QUIT
FOR
SET TIUDA=$ORDER(^TIU(8925,"F",STRTDT,TIUDA))
if TIUDA=""
QUIT
IF +$GET(^TIU(8925,TIUDA,0))=OPREPORT
Begin DoDot:1
+7 NEW DATA,DISPLAY,MSG
+8 IF '$DATA(TIUADD($$GET1^DIQ(8925,TIUDA,.02)))
QUIT
+9 ; D CANDO^TIUSRVA(.MSG,TIUDA,"MAKE ADDENDUM") I '+MSG Q
+10 SET VALMCNT=VALMCNT+1
if VALMCNT#3=0
WRITE "."
+11 SET DISPLAY=$$SETSTR^VALM1(VALMCNT,"",1,4)
+12 SET DISPLAY=$$SETSTR^VALM1($$PATIENT^TIU144($PIECE($GET(^TIU(8925,TIUDA,0)),U,2)),DISPLAY,6,38)
+13 SET DISPLAY=$$SETSTR^VALM1(TIUDA,DISPLAY,40,50)
+14 SET DISPLAY=$$SETSTR^VALM1($$FDATE^VALM1($$GET1^DIQ(8925,TIUDA,1201,"I")),DISPLAY,52,62)
+15 SET DISPLAY=$$SETSTR^VALM1($$GET1^DIQ(8925,TIUDA,.05),DISPLAY,62,71)
+16 SET DISPLAY=$$SETSTR^VALM1("#"_+$PIECE($GET(^TIU(8925,TIUDA,14)),U,5),DISPLAY,75,80)
+17 DO SET^VALM10(VALMCNT,DISPLAY,TIUDA)
End DoDot:1
+18 IF VALMCNT=0
Begin DoDot:1
+19 DO SET^VALM10(2,$$SETSTR^VALM1("No records found to satisfy search criteria.","",(IOM-$LENGTH("No records found to satisfy search criteria."))/2,$LENGTH("No records found to satisfy search criteria.")),0)
End DoDot:1
+20 QUIT
XQORM ; default action for list manager
+1 SET XQORM("#")=$ORDER(^ORD(101,"B","TIU UNK ADDENDA SELECT",0))_U_"1:"_VALMCNT
+2 QUIT
ATTACH ;
+1 NEW DISPLAY,LINE,PARENT
+2 DO FULL^VALM1
WRITE @IOF
+3 WRITE "Attach the following UNKNOWN "_$SELECT($$MULTI^TIUADCL("TIUADD")>1:"Addenda",1:"Addendum")_":",!!
+4 WRITE "TIU",!,"Doc No.",?9,"Patient",?40,"Entry DT/Time",?59,"Status",?71,"Parent",!
+5 SET LINE=""
SET PARENT=$$ONEDOC^TIUADCL()
+6 SET $PIECE(LINE,"-",80)="-"
WRITE LINE
+7 SET TIUADD=""
FOR
SET TIUADD=$ORDER(TIUADD(TIUADD))
if TIUADD=""!(+TIUADD'>0)
QUIT
Begin DoDot:1
+8 NEW TIUDA
+9 SET TIUDA=TIUADD(TIUADD)
+10 SET DISPLAY=$$SETSTR^VALM1(TIUDA,"",1,8)
+11 SET DISPLAY=$$SETSTR^VALM1($$PATIENT^TIU144($PIECE($GET(^TIU(8925,TIUDA,0)),U,2)),DISPLAY,10,40)
+12 SET DISPLAY=$$SETSTR^VALM1($$FDTTM^VALM1($$GET1^DIQ(8925,TIUDA,1201,"I")),DISPLAY,41,51)
+13 SET DISPLAY=$$SETSTR^VALM1($$GET1^DIQ(8925,TIUDA,.05),DISPLAY,60,67)
+14 SET DISPLAY=$$SETSTR^VALM1($SELECT($$GET1^DIQ(8925,TIUDA,.06)="":"None",1:$$GET1^DIQ(8925,TIUDA,.06)),DISPLAY,72,80)
+15 WRITE $EXTRACT(DISPLAY,1,80)
End DoDot:1
+16 WRITE !!,"to the following "_$$GET1^DIQ(8925,PARENT,.01)_"?",!
+17 SET DISPLAY=$$SETSTR^VALM1(PARENT,"",1,8)
+18 SET DISPLAY=$$SETSTR^VALM1($$PATIENT^TIU144($PIECE($GET(^TIU(8925,PARENT,0)),U,2)),DISPLAY,10,40)
+19 SET DISPLAY=$$SETSTR^VALM1($$FDTTM^VALM1($$GET1^DIQ(8925,PARENT,1201,"I")),DISPLAY,41,51)
+20 SET DISPLAY=$$SETSTR^VALM1($$GET1^DIQ(8925,PARENT,.05),DISPLAY,60,67)
+21 SET DISPLAY=$$SETSTR^VALM1("#"_+$PIECE($GET(^TIU(8925,PARENT,14)),U,5),DISPLAY,72,80)
+22 WRITE !,"TIU",?71,"Surgical",!,"Doc No.",?9,"Patient",?40,"Entry DT/Time",?59,"Status",?71,"Case No.",!
+23 WRITE LINE,$EXTRACT(DISPLAY,1,80),!
+24 SET VALMBCK="R"
+25 IF '$$READ^TIUU("Y","Do you wish to begin attaching","NO","Enter 'Y' or 'N'")
WRITE !
IF $$READ^TIUU("EA","Press <RETURN> to continue")
QUIT
+26 SET VALMBCK="Q"
+27 SET TIUADD=""
FOR
SET TIUADD=$ORDER(TIUADD(TIUADD))
if TIUADD=""!(+TIUADD'>0)
QUIT
Begin DoDot:1
+28 NEW TIUDA
+29 SET TIUDA=TIUADD(TIUADD)
+30 WRITE !!,"Attaching #",TIUDA," to #",PARENT," ... "
+31 DO ATNOW(PARENT,TIUDA)
End DoDot:1
+32 WRITE !
IF $$READ^TIUU("EA","Press <RETURN> to continue")
+33 QUIT
ATNOW(PARENT,ADDENDUM) ;
+1 NEW FDA,FDARR,IENS,FLAGS,TIUMSG,TIUA0,TIUA12,TIUP0,TIUP12,TIUWARN
+2 SET TIUP0=$GET(^TIU(8925,PARENT,0))
SET TIUA0=$GET(^TIU(8925,ADDENDUM,0))
+3 SET TIUP12=$GET(^TIU(8925,PARENT,12))
SET TIUA12=$GET(^TIU(8925,ADDENDUM,12))
+4 IF $PIECE(TIUP0,U,2)'=$PIECE(TIUA0,U,2)
WRITE !,"ERROR: Parent and Addendum have different patients!"
SET TIUWARN=1
+5 IF $PIECE(TIUA12,U)'>$PIECE(TIUP12,U)
WRITE !,"ERROR: The addendum's ENTRY DATE/TIME precedes the parent's ENTRY DATE/TIME!"
SET TIUWARN=1
+6 IF +$GET(TIUWARN)
QUIT
+7 SET IENS=""""_ADDENDUM_","""
SET FDARR="FDA(8925,"_IENS_")"
SET FLAGS="K"
+8 SET @FDARR@(.06)=PARENT
+9 SET @FDARR@(1405)=$$GET1^DIQ(8925,PARENT,1405,"I")
+10 DO FILE^DIE(FLAGS,"FDA","TIUMSG")
+11 IF $DATA(TIUMSG)
Begin DoDot:1
+12 NEW LINE
SET LINE=""
+13 FOR
SET LINE=$ORDER(TIUMSG("DIERR",1,"TEXT",LINE))
if LINE=""
QUIT
WRITE !,TIUMSG("DIERR",1,"TEXT",LINE)
End DoDot:1
QUIT
+14 WRITE ?29," success!"
+15 QUIT
SAVEADD ;
+1 SET TIUADD=0
+2 FOR
SET TIUADD=$ORDER(TIUDOCS(TIUADD))
if TIUADD=""
QUIT
SET TIUADD(TIUADD)=TIUDOCS(TIUADD)
SET TIUADD($$GET1^DIQ(8925,TIUADD(TIUADD),.02))=""
+3 QUIT
PREP ;
+1 NEW DA,DIC,DIK,X,Y
+2 SET DIC="^SD(409.61,"
SET DIC(0)="X"
+3 FOR X="TIU UNK ADDENDA ATTACH","TIU UNK ADDENDA CLEANUP"
Begin DoDot:1
+4 DO ^DIC
IF +Y
Begin DoDot:2
+5 SET DA=+Y
SET DIK=DIC
DO ^DIK
End DoDot:2
End DoDot:1
+6 QUIT
