Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUADCL1

TIUADCL1.m

Go to the documentation of this file. 
  1. TIUADCL1 ; SLC/AJB - UNK Addenda Cleanup ; 10/01/04
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**173**;Jun 20, 1997
  1.  ;
  1.  ; Cleanup Utility for OPERATION REPORT addenda.
  1.  ; Finds parentless/unknown addenda and attaches to user
  1.  ; selected parent.
  1.  ;
  1.  Q
  1. EN ; main entry point for TIU UNK ADDENDA CLEANUP
  1.  N DTR2,TIUADD,TIULVL,TIUQUIT
  1.  D SAVEADD
  1.  D DTRANGE^TIUADCL(.DTR2) Q:$D(TIUQUIT)
  1.  D EN^VALM("TIU UNK ADDENDA ATTACH")
  1.  K ^TMP("VALMAR",$J,TIULVL)
  1.  Q
  1. EXIT ;
  1.  D XQORM
  1.  Q
  1. HDR ; sets header
  1.  N HDR
  1.  S HDR="OPERATION REPORTS from "_$$FMTE^XLFDT(DTR2("BEGDT"),"D")_" to "_$$FMTE^XLFDT(DTR2("ENDDT"),"D")
  1.  S VALMHDR(1)=$$SETSTR^VALM1(HDR,"",(IOM-$L(HDR))/2,$L(HDR))
  1.  D XQORM
  1.  Q
  1. HELP ; help code
  1.  N DIR
  1.  I X="?" S DIR("A")="Enter RETURN to continue or '^' to exit",DIR(0)="E"
  1.  D FULL^VALM1
  1.  W !!,"The following actions are available:"
  1.  W !,"Browse a Document  - View a selected document (if authorized)"
  1.  W !,"Change View        - Modify search criteria"
  1.  W !,"Detailed Display   - View detailed display of a document (if authorized)"
  1.  W !,"Attach to Parent   - Attach the currently selected "
  1.  W $S($$MULTI^TIUADCL("TIUADD")>1:"addenda",1:"addendum")," to one OPERATION"
  1.  W !,"                     REPORT",!
  1.  I $D(DIR("A")) D ^DIR
  1.  S VALMBCK="R"
  1.  Q
  1. INIT ; finds unknown addenda & creates list
  1.  N OPREPORT,STRTDT,TIUDA,TIU
  1.  S TIULVL=VALMEVL,TIU("IOCUOFF")=$C(27)_"[?25l",TIU("IOCUON")=$C(27)_"[?25h"
  1.  W TIU("IOCUOFF")
  1.  W !!,"Searching for the documents."
  1.  S OPREPORT=$$CHKFILE^TIUADCL(8925.1,"OPERATION REPORT","I $P(^(0),U,4)=""DOC"""),TIUDA="",STRTDT=DTR2("BEGDT"),VALMCNT=0
  1.  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
  1.  . N DATA,DISPLAY,MSG
  1.  . I '$D(TIUADD($$GET1^DIQ(8925,TIUDA,.02))) Q
  1.  . ; D CANDO^TIUSRVA(.MSG,TIUDA,"MAKE ADDENDUM") I '+MSG Q
  1.  . S VALMCNT=VALMCNT+1 W:VALMCNT#3=0 "."
  1.  . S DISPLAY=$$SETSTR^VALM1(VALMCNT,"",1,4)
  1.  . S DISPLAY=$$SETSTR^VALM1($$PATIENT^TIU144($P($G(^TIU(8925,TIUDA,0)),U,2)),DISPLAY,6,38)
  1.  . S DISPLAY=$$SETSTR^VALM1(TIUDA,DISPLAY,40,50)
  1.  . S DISPLAY=$$SETSTR^VALM1($$FDATE^VALM1($$GET1^DIQ(8925,TIUDA,1201,"I")),DISPLAY,52,62)
  1.  . S DISPLAY=$$SETSTR^VALM1($$GET1^DIQ(8925,TIUDA,.05),DISPLAY,62,71)
  1.  . S DISPLAY=$$SETSTR^VALM1("#"_+$P($G(^TIU(8925,TIUDA,14)),U,5),DISPLAY,75,80)
  1.  . D SET^VALM10(VALMCNT,DISPLAY,TIUDA)
  1.  I VALMCNT=0 D
  1.  . 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)
  1.  Q
  1. XQORM ; default action for list manager
  1.  S XQORM("#")=$O(^ORD(101,"B","TIU UNK ADDENDA SELECT",0))_U_"1:"_VALMCNT
  1.  Q
  1. ATTACH ;
  1.  N DISPLAY,LINE,PARENT
  1.  D FULL^VALM1 W @IOF
  1.  W "Attach the following UNKNOWN "_$S($$MULTI^TIUADCL("TIUADD")>1:"Addenda",1:"Addendum")_":",!!
  1.  W "TIU",!,"Doc No.",?9,"Patient",?40,"Entry DT/Time",?59,"Status",?71,"Parent",!
  1.  S LINE="",PARENT=$$ONEDOC^TIUADCL()
  1.  S $P(LINE,"-",80)="-" W LINE
  1.  S TIUADD="" F  S TIUADD=$O(TIUADD(TIUADD)) Q:TIUADD=""!(+TIUADD'>0)  D
  1.  . N TIUDA
  1.  . S TIUDA=TIUADD(TIUADD)
  1.  . S DISPLAY=$$SETSTR^VALM1(TIUDA,"",1,8)
  1.  . S DISPLAY=$$SETSTR^VALM1($$PATIENT^TIU144($P($G(^TIU(8925,TIUDA,0)),U,2)),DISPLAY,10,40)
  1.  . S DISPLAY=$$SETSTR^VALM1($$FDTTM^VALM1($$GET1^DIQ(8925,TIUDA,1201,"I")),DISPLAY,41,51)
  1.  . S DISPLAY=$$SETSTR^VALM1($$GET1^DIQ(8925,TIUDA,.05),DISPLAY,60,67)
  1.  . S DISPLAY=$$SETSTR^VALM1($S($$GET1^DIQ(8925,TIUDA,.06)="":"None",1:$$GET1^DIQ(8925,TIUDA,.06)),DISPLAY,72,80)
  1.  . W $E(DISPLAY,1,80)
  1.  W !!,"to the following "_$$GET1^DIQ(8925,PARENT,.01)_"?",!
  1.  S DISPLAY=$$SETSTR^VALM1(PARENT,"",1,8)
  1.  S DISPLAY=$$SETSTR^VALM1($$PATIENT^TIU144($P($G(^TIU(8925,PARENT,0)),U,2)),DISPLAY,10,40)
  1.  S DISPLAY=$$SETSTR^VALM1($$FDTTM^VALM1($$GET1^DIQ(8925,PARENT,1201,"I")),DISPLAY,41,51)
  1.  S DISPLAY=$$SETSTR^VALM1($$GET1^DIQ(8925,PARENT,.05),DISPLAY,60,67)
  1.  S DISPLAY=$$SETSTR^VALM1("#"_+$P($G(^TIU(8925,PARENT,14)),U,5),DISPLAY,72,80)
  1.  W !,"TIU",?71,"Surgical",!,"Doc No.",?9,"Patient",?40,"Entry DT/Time",?59,"Status",?71,"Case No.",!
  1.  W LINE,$E(DISPLAY,1,80),!
  1.  S VALMBCK="R"
  1.  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
  1.  S VALMBCK="Q"
  1.  S TIUADD="" F  S TIUADD=$O(TIUADD(TIUADD)) Q:TIUADD=""!(+TIUADD'>0)  D
  1.  . N TIUDA
  1.  . S TIUDA=TIUADD(TIUADD)
  1.  . W !!,"Attaching #",TIUDA," to #",PARENT,"  ... "
  1.  . D ATNOW(PARENT,TIUDA)
  1.  W ! I $$READ^TIUU("EA","Press <RETURN> to continue")
  1.  Q
  1. ATNOW(PARENT,ADDENDUM) ;
  1.  N FDA,FDARR,IENS,FLAGS,TIUMSG,TIUA0,TIUA12,TIUP0,TIUP12,TIUWARN
  1.  S TIUP0=$G(^TIU(8925,PARENT,0)),TIUA0=$G(^TIU(8925,ADDENDUM,0))
  1.  S TIUP12=$G(^TIU(8925,PARENT,12)),TIUA12=$G(^TIU(8925,ADDENDUM,12))
  1.  I $P(TIUP0,U,2)'=$P(TIUA0,U,2) W !,"ERROR:  Parent and Addendum have different patients!" S TIUWARN=1
  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
  1.  I +$G(TIUWARN) Q
  1.  S IENS=""""_ADDENDUM_",""",FDARR="FDA(8925,"_IENS_")",FLAGS="K"
  1.  S @FDARR@(.06)=PARENT
  1.  S @FDARR@(1405)=$$GET1^DIQ(8925,PARENT,1405,"I")
  1.  D FILE^DIE(FLAGS,"FDA","TIUMSG")
  1.  I $D(TIUMSG) D  Q
  1.  . N LINE S LINE=""
  1.  . F  S LINE=$O(TIUMSG("DIERR",1,"TEXT",LINE)) Q:LINE=""  W !,TIUMSG("DIERR",1,"TEXT",LINE)
  1.  W ?29," success!"
  1.  Q
  1. SAVEADD ;
  1.  S TIUADD=0
  1.  F  S TIUADD=$O(TIUDOCS(TIUADD)) Q:TIUADD=""  S TIUADD(TIUADD)=TIUDOCS(TIUADD),TIUADD($$GET1^DIQ(8925,TIUADD(TIUADD),.02))=""
  1.  Q
  1. PREP ;
  1.  N DA,DIC,DIK,X,Y
  1.  S DIC="^SD(409.61,",DIC(0)="X"
  1.  F X="TIU UNK ADDENDA ATTACH","TIU UNK ADDENDA CLEANUP" D
  1.  . D ^DIC I +Y D
  1.  .. S DA=+Y,DIK=DIC D ^DIK
  1.  Q