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

TIUP113.m

Go to the documentation of this file. 
  1. TIUP113 ; SLC/JAK - Post-Install for TIU*1*113 ;12/01/03
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**113**;Jun 20, 1997
  1. BUILD ; -- Rebuild SEARCH CATEGORIES so DIVISION is selectable
  1.  D KILL^TIUDD8
  1.  Q
  1. MAIN ; -- Control unit
  1.  N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1.  W !!,"PATCH TIU*1*113"
  1.  W !!,"Load the DIVISION field for TIU DOCUMENT file (#8925) entries.",!
  1.  S ZTRTN="SETDIV^TIUP113",ZTIO="",ZTSAVE("DUZ")=""
  1.  S ZTDESC="DIVISION field load for File #8925 - Patch 113"
  1.  D ^%ZTLOAD
  1.  I $G(ZTSK) D
  1.  . W !!,"A task has been queued in the background and a bulletin will be sent"
  1.  . W !,"to you upon completion of the task or if the task is stopped."
  1.  . W !!,"The task number is "_$G(ZTSK)_"."
  1.  Q
  1. SETDIV ; -- Automatically set division for documents
  1.  N TIUCNT,TIUDA,TIUS
  1.  S ^XTMP("TIUP113","T0")=$$NOW^XLFDT
  1.  ; Initialize re-start if check point exists
  1.  I +$G(^XTMP("TIUP113","CHKPT")) D
  1.  . S TIUDA=+$G(^XTMP("TIUP113","CHKPT"))
  1.  E  D
  1.  . ; Initialize if not re-start
  1.  . S ^XTMP("TIUP113",0)=$$FMADD^XLFDT(DT,90)_U_DT
  1.  . S ^XTMP("TIUP113","EX")=0 F TIUS=1,2 S ^XTMP("TIUP113","EX",TIUS)=0
  1.  . S (TIUDA,^XTMP("TIUP113","CHKPT"))=0
  1.  K ^XTMP("TIUP113","STOP")
  1.  ;
  1.  ; Loop thru TIU Document entries
  1.  F  S TIUDA=$O(^TIU(8925,TIUDA)) Q:+TIUDA'>0!($G(ZTSTOP))  D
  1.  . S TIUCNT=+$G(TIUCNT)+1
  1.  . ; Register activity in the ^XTMP("TIUP113", array
  1.  . S ^XTMP("TIUP113","CHKPT")=TIUDA
  1.  . ; Check if user requested to stop task
  1.  . I $G(TIUCNT)>1000 D
  1.  . . I $$S^%ZTLOAD S ZTSTOP=1
  1.  . . E  S TIUCNT=0
  1.  . ;
  1.  . I +$P($G(^TIU(8925,TIUDA,12)),U,12) Q
  1.  . N TIUDTYP,TIUEX
  1.  . S TIUDTYP=+$P($G(^TIU(8925,TIUDA,0)),U)
  1.  . ; -- Ignore records of (document type) type=component
  1.  . I TIUDTYP,$P($G(^TIU(8925.1,TIUDTYP,0)),U,4)="CO" Q
  1.  . ; -- Check if hospital location and entry date/time don't exist
  1.  . I '$D(^TIU(8925,TIUDA,12)) D SETEX(TIUDA,1) Q
  1.  . ; -- Get IFP from HL's Division
  1.  . N RESULT,TIUE,TIUHL,TIUDVHL,TIUIFP
  1.  . S (TIUDVHL,TIUE,TIUHL,TIUIFP)=0
  1.  . S TIUHL=+$P($G(^TIU(8925,TIUDA,12)),U,5) I TIUHL D
  1.  . . S TIUDVHL=+$P($G(^SC(TIUHL,0)),U,15) I TIUDVHL D
  1.  . . . S TIUE=+$P($G(^TIU(8925,TIUDA,12)),U) I TIUE D
  1.  . . . . S TIUIFP=+$$SITE^VASITE(TIUE,TIUDVHL) I TIUIFP>0 S RESULT=TIUIFP
  1.  . I 'TIUHL!('TIUDVHL)!('TIUE)!(TIUIFP<0) D
  1.  . . D SETEX(TIUDA,1)
  1.  . E  D
  1.  . . D SETRSLT(TIUDA,RESULT)
  1.  ;
  1. SETCHKQ ; Send bulletin and re-set check point
  1.  I $G(ZTSTOP) S ^XTMP("TIUP113","STOP")=$$NOW^XLFDT
  1.  S ^XTMP("TIUP113","T1")=$$NOW^XLFDT
  1.  S ^XTMP("TIUP113","EX")=+$G(^XTMP("TIUP113","EX",1))+(+$G(^XTMP("TIUP113","EX",2)))
  1.  ;
  1.  D MAIL^TIUP113P
  1.  ;
  1.  I '$G(ZTSTOP) S ^XTMP("TIUP113","CHKPT")=""
  1.  Q
  1. SETEX(TIUDA,TIUEX) ; -- Load ^XTMP with exception entries
  1.  ; Input -- TIUDA  TIU Document file (#8925) IEN
  1.  ;          TIUEX  Exception types:
  1.  ;                 1=Cannot determine DIVISION from Hospital Location
  1.  ;                 2=Attempted to load DIVISION data but entry in use
  1.  ;                 (value=1) (see SETRSLT for value=2)
  1.  S ^XTMP("TIUP113","EX",TIUEX,TIUDA)=""
  1.  S ^XTMP("TIUP113","EX",TIUEX)=+$G(^XTMP("TIUP113","EX",TIUEX))+1
  1.  Q
  1. SETRSLT(TIUDA,RESULT) ; -- Set DIVISION data and ADIV x-ref
  1.  ; Input -- TIUDA   TIU Document file (#8925) IEN
  1.  ;          RESULT  Institution file (#4) IEN
  1.  N DIE,DR,DA
  1.  L +^TIU(8925,+TIUDA):5 E  D  Q
  1.  . S ^XTMP("TIUP113","EX",2,TIUDA)=RESULT
  1.  . S ^XTMP("TIUP113","EX",2)=+$G(^XTMP("TIUP113","EX",2))+1
  1.  S DIE="^TIU(8925,",DA=+TIUDA,DR="1212////^S X=RESULT"
  1.  D ^DIE
  1.  L -^TIU(8925,+TIUDA)
  1.  Q
  1. UPDATE ; -- Exception entries
  1.  W !,"If you did not receive a mail message which indicated the post-"
  1.  W !,"install COMPLETED, you must invoke MAIN^TIUP113 from Programmer"
  1.  W !,"mode before following the instructions below.",!
  1.  N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  N RESULT,TIUCHC,TIUDA,TIUDIV,TIUI,TIUJ,TIUK,TIUNOEX,TIUOUT,TIUS
  1.  S TIUOUT=0 F TIUK=7,9,18 S DIR("A",TIUK)=""
  1.  S DIR("A",1)="Below are listed the choices for what action(s) to take"
  1.  S DIR("A",2)="on the exception entries. It is recommended you select"
  1.  S DIR("A",3)="choice 3 and also possibly choice 2. The numbers can be"
  1.  S DIR("A",4)="selected by commas, dashes, or a combination of both."
  1.  S DIR("A",5)="You can invoke this entry point (>D UPDATE^TIUP113)"
  1.  S DIR("A",6)="as often as you wish."
  1.  S DIR("A",8)="CHOICES:"
  1.  S DIR("A",10)="1- Exit and do not load Division for exception entries."
  1.  S DIR("A",11)="2- For exception entries in which Division could not be"
  1.  S DIR("A",12)="   determined from the Hospital Location, prompt me to"
  1.  S DIR("A",13)="   select one Division and load entries with this"
  1.  S DIR("A",14)="   Division. (type A)"
  1.  S DIR("A",15)="3- For exception entries that were previously in use,"
  1.  S DIR("A",16)="   try to load Division data again. (type B)"
  1.  S DIR("A")="Select (a) NUMBER(S)"
  1.  S DIR(0)="L^1:3" D ^DIR G EXIT:$D(DIRUT) S TIUCHC=Y
  1.  I TIUCHC[1 Q
  1.  I TIUCHC[2 N DIR,X,Y S DIR(0)="P^40.8" D ^DIR G EXIT:Y'>0!$D(DIRUT) D
  1.  . S TIUDIV=+Y,TIUIFP=+$$SITE^VASITE(,TIUDIV),RESULT=TIUIFP
  1.  F TIUI=1:1:($L(TIUCHC,",")-1) D
  1.  . S TIUS=$P(TIUCHC,",",TIUI)
  1.  . I TIUS=2 D NOEX(TIUS,1) I 'TIUNOEX D
  1.  . . N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1.  . . S ZTRTN="TWOA^TIUP113",ZTIO=""
  1.  . . S (ZTSAVE("DUZ"),ZTSAVE("RESULT"))=""
  1.  . . S ZTDESC="Choice 2 UPDATE^TIUP113 - Patch 113"
  1.  . . D ^%ZTLOAD
  1.  . . I $G(ZTSK) D
  1.  . . . W !!,"A task has been queued in the background for Choice 2."
  1.  . . . W !,"The task number is "_$G(ZTSK)_"."
  1.  . . Q
  1.  . I TIUS=3 D THREEB(TIUS)
  1.  Q
  1. TWOA ; -- Load entries with selection
  1.  ; Input -- RESULT  Institution file (#4) IEN
  1.  N TIUCNT
  1.  S TIUDA=0 D
  1.  . F  S TIUDA=$O(^XTMP("TIUP113","EX",1,TIUDA)) Q:+TIUDA'>0!($G(ZTSTOP))  D
  1.  . . D SETRSLT(TIUDA,RESULT)
  1.  . . K ^XTMP("TIUP113","EX",1,TIUDA)
  1.  . . S TIUCNT=+$G(TIUCNT)+1
  1.  . . ; Check if user requested to stop task
  1.  . . I $G(TIUCNT)>1000 D
  1.  . . . I $$S^%ZTLOAD S ZTSTOP=1
  1.  . . . E  S TIUCNT=0
  1.  ;
  1.  I '$G(ZTSTOP) S ^XTMP("TIUP113","EX",1)=0
  1.  Q
  1. THREEB(TIUS) ; -- Try to load locked entries
  1.  ; Input --   TIUS  Choice 3
  1.  S TIUDA=0 N RESULT D NOEX(TIUS,2) I 'TIUNOEX D
  1.  . W !!,"...Choice 3 - UPDATING NOW....",!!
  1.  . F  S TIUDA=$O(^XTMP("TIUP113","EX",2,TIUDA)) Q:+TIUDA'>0  D
  1.  . . S RESULT=$G(^XTMP("TIUP113","EX",2,TIUDA))
  1.  . . D SETRSLT(TIUDA,RESULT)
  1.  . . I +$P($G(^TIU(8925,TIUDA,12)),U,12) K ^XTMP("TIUP113","EX",2,TIUDA)
  1.  . S ^XTMP("TIUP113","EX",2)=0
  1.  Q
  1. NOEX(TIUS,TIUJ) ; -- No exceptions
  1.  ; Input -- TIUS  Choice 2 or 3
  1.  ;       -- TIUJ  Exception entry types A (1) or B (2)
  1.  S TIUNOEX=0
  1.  I +$G(^XTMP("TIUP113","EX",TIUJ))=0 D
  1.  . W !,"Choice: ",TIUS,"-type ",$S(TIUJ=2:"B",1:"A")
  1.  . W " has no exceptions."
  1.  . S TIUNOEX=1
  1.  Q
  1. DEVICE ; -- Device Selection
  1.  N TIUMSG,TIUOUT S TIUOUT=0
  1.  S TIUMSG(1)="Remember to finish the post-install after review of"
  1.  S TIUMSG(2)="the output by invoking UPDATE^TIUP113"
  1.  D MES^XPDUTL(.TIUMSG)
  1.  W !! S %ZIS="Q" D ^%ZIS I POP K POP S TIUOUT=1 G EXIT
  1.  I $D(IO("Q")) D  Q
  1.  . S ZTRTN="PRINT^TIUP113"
  1.  . S ZTDESC="TIU*1*113 POST-INSTALL EXCEPTION LIST"
  1.  . D ^%ZTLOAD W !,$S($D(ZTSK):"Request queued",1:"Request Cancelled!")
  1.  . K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,%ZIS
  1.  . D HOME^%ZIS
  1.  U IO D PRINT,^%ZISC
  1.  Q
  1. PRINT ; -- Print job
  1.  N TIUDA,TIUIFP,TIUOUT,TIUS,TIUST S TIUOUT=0
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  F TIUS=1,2 Q:TIUOUT  S TIUDA=0 D
  1.  . I TIUS=2 D ASK Q:TIUOUT
  1.  . D HDR W !!,$P($T(EXHDR+TIUS),";",3)
  1.  . I +$G(^XTMP("TIUP113","EX",TIUS))=0 W !?4,"No exceptions." Q
  1.  . F  S TIUDA=$O(^XTMP("TIUP113","EX",TIUS,TIUDA)) Q:+TIUDA'>0!(TIUOUT)  D
  1.  . . I $Y>(IOSL-4) D ASK Q:TIUOUT  D HDR W !!,$P($T(EXHDR+TIUS),";",3)
  1.  . . W !?4,TIUDA
  1.  . . S TIUST=$P($G(^TIU(8925,+TIUDA,0)),U,5) I TIUST>0 D
  1.  . . . W "  ",$P($G(^TIU(8925.6,+TIUST,0)),U)
  1.  . . I TIUS=2 D
  1.  . . . S TIUIFP=$G(^XTMP("TIUP113","EX",2,TIUDA))
  1.  . . . W ": ",$$GET1^DIQ(4,TIUIFP,.01)
  1.  Q
  1. ASK ; -- End of Page
  1.  I IO=IO(0),$E(IOST)="C" D
  1.  . W ! N DIR,X,Y S DIR(0)="E"
  1.  . D ^DIR I $D(DUOUT)!$D(DTOUT) S TIUOUT=1
  1.  Q
  1. HDR ; -- Header
  1.  N LNE,TIUNOW
  1.  D NOW^%DTC S Y=% X ^DD("DD") S TIUNOW=Y
  1.  W @IOF,"TIU*1*113 POST-INSTALL EXCEPTION LIST - Printed: ",TIUNOW
  1.  W !!,"Listed below are TIU DOCUMENT entry numbers that did not get "
  1.  W "DIVISION data",!,"loaded. If a division name is listed with an "
  1.  W "entry number, the record was",!,"in use and the division data "
  1.  W "could not be loaded."
  1.  W ! S LNE="",$P(LNE,"-",(IOM-1))="" W LNE
  1.  Q
  1. EXHDR ; -- Exception entry headers
  1.  ;;A. Cannot determine DIVISION from Hospital Location: 
  1.  ;;B. Attempted to load DIVISION data but entry in use: 
  1.  ;
  1. EXIT ; -- Exits here if ^ at: DEVICE prompt,
  1.  ; -- two UPDATE areas, or at End of Page
  1.  I TIUOUT D
  1.  . W $C(7),$C(7),!!,"OK...please remember to finish the post-install "
  1.  . W "by: >D UPDATE^TIUP113"
  1.  Q