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