TIURA ; SLC/JER - Review screen actions ; 7/7/04
;;1.0;TEXT INTEGRATION UTILITIES;**1,10,20,79,88,58,100,109,182**;Jun 20, 1997
; Call to ISA^USRLM supported by DBIA 2324
EDIT ; Edit Documents
N TIUDA,DFN,TIUDDT,TIUDATA,TIUCHNG,TIUEDIT,TIUI,DIROUT,TIUDAARY
N TIULST,MSGVERB
S TIUI=0
I '$D(VALMY) D EN^VALM2(XQORNOD(0))
F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
. N RSTRCTD
. S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
. D CLEAR^VALM1 W !!,"Editing #",+TIUDATA
. S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
. I RSTRCTD D Q
. . W !!,$C(7),"Ok, no harm done...",!
. . I $$READ^TIUU("EA","RETURN to continue...") ; pause
. S TIUDAARY(TIUI)=TIUDA
. S TIUCHNG=0
. I +$D(^TIU(8925,+TIUDA,0)) D EDIT1
. I +$G(TIUCHNG) D
. . S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
; -- Update or Rebuild list, restore video: --
I $G(TIUCHNG("ADDM"))!$G(TIUCHNG("DELETE")) S TIUCHNG("RBLD")=1
E S TIUCHNG("UPDATE")=1
D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
S VALMBCK="R"
S MSGVERB=$S($G(TIUCHNG("ADDM")):"edited/addended",1:"edited")
D VMSG^TIURS1($G(TIULST),.TIUDAARY,MSGVERB)
Q
EDIT1 ; Single record edit
; Receives TIUDA
N %X,%Y,C,D,D0,DDWTMP,DFN,DI,DIC,TIUEDIT,TIUMSG,TIUQUIT,TIUADD,TIUREL
N TIUTYP,TIUT0,TIUDPRM,TIULDT,DIWESUB,TIU,TIUCMMTX
I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
I '+$G(TIUDA) W !,"No Documents selected." H 2 Q
; Evaluate edit privilege
S TIUEDIT=$$CANDO^TIULP(TIUDA,"EDIT RECORD")
; if 'canedit, offer explanation, and let add addendum
I '+TIUEDIT D Q
. K ^TIU(8925,"ASAVE",DUZ,TIUDA)
. W !!,$C(7),$P(TIUEDIT,U,2),!
. I $$READ^TIUU("EA","Press RETURN to continue...")
. D ADDENDUM^TIUADD(TIUDA,"",.TIUCHNG)
S TIUTYP=+$G(^TIU(8925,+TIUDA,0)),TIUT0=$G(^TIU(8925.1,+TIUTYP,0))
S TIUTYP(1)="1^"_+TIUTYP_U_$P(TIUT0,U,3)_U
S DFN=$P($G(^TIU(8925,+TIUDA,0)),U,2),TIULDT=$P(^(0),U,8)
D GETTIU^TIULD(.TIU,TIUDA)
S DIWESUB="Patient: "_$G(TIU("PNM"))
D DIE^TIUEDI4(TIUDA,.TIUQUIT,.TIUCHNG) ; **100**
K ^TIU(8925,"ASAVE",DUZ,TIUDA)
I +$G(TIUCPYNG),+$G(TIUQUIT) D DELETE^TIUEDIT(TIUDA,0,"",1) Q
Q:+$G(TIUQUIT)=2
;If (CP) and (Timeout or Not Select Consult) and (Consult Associated), Quit before EMPTYDOC check
I +$$ISA^TIULX(TIUTYP,+$$CLASS^TIUCP),+$G(TIUQUIT)=1,+$P($G(^TIU(8925,+TIUDA,14)),U,5)>0 Q
I $$EMPTYDOC^TIULF(TIUDA) D DELETE^TIUEDIT(TIUDA,0) S TIUCHNG("DELETE")=1 H 2 Q
Q:+$G(TIUQUIT)
I +$G(TIU("STOP")) D DEFER^TIUVSIT(TIUDA,TIU("STOP")) I 1
E I +$P($G(^TIU(8925,+TIUDA,0)),U,3)'>0 D QUE^TIUPXAP1
; - Commit proc -
S TIUCMMTX=$$COMMIT^TIULC1(+$P(TIUTYP(1),U,2))
I TIUCMMTX]"" D
. N DA S DA=TIUDA X TIUCMMTX
; i. Execute RELEASE logic
D RELEASE^TIUT(+TIUDA)
; ii. Execute VERIFICATION logic
D VERIFY^TIUT(+TIUDA)
; iii. Execute ES logic
D EDSIG^TIURS(+TIUDA,"",1)
; iv. If document is an ADDENDUM process alert
I +$$ISADDNDM^TIULC1(+TIUDA) D SENDADD^TIUALRT(+TIUDA)
I $D(^TMP("TIUR",$J,"CTXT")),(+$P($G(^TIU(8925,+TIUDA,0)),U,5)'<6) S VALMBCK="Q"
Q
PRINT ; Print selected documents
N DFN,TIUDA,TIUDARR,TIUDATA,TIUI,DIROUT,TIUDE,POP,TIUPFLG,TIUDEV
I '$D(VALMY) D EN^VALM2(XQORNOD(0)) G:$D(VALMY)'>9 PRINTX
D CLEAR^VALM1
D PRNTSCRN^TIURA2(.VALMY)
I '$D(VALMY) D G PRINTX
. W !!,"No Printable Documents Remain in your List.",!
. I $$READ^TIUU("EA","Press RETURN to continue...")
I +$$CHARTANY^TIURA1(.VALMY) S TIUPFLG=$$FLAG^TIUPRPN3
S TIUDEV=$$DEVICE^TIUDEV(.IO) ; Get Device/allow queueing
I $S(IO']"":1,TIUDEV']"":1,1:0) G PRINTX
I $D(IO("Q")) D QUE^TIUDEV("PRINTN^TIURA",TIUDEV) G PRINTX
D PRINTN
PRINTX N IOSTBM D ^%ZISC,FIXLSTNW^TIULM
K VALMY S VALMBCK="R"
Q
PRINTN ; Loop through selected doc's & invoke print code
N TIUI,TIUTYP,TIUDARR,DFN K ^TMP("TIUPR",$J)
N ARRAYDA
U IO
S TIUI=0
F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
. N TIUPMTHD,TIUDTYP,TIUPFHDR,TIUPFNBR,TIUPGRP,TIUPRINT,TIUFLAG
. S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
. S TIUDA=+$P(TIUDATA,U,2)
. S TIUTYP=+$G(^TIU(8925,TIUDA,0)) ;P182
. I TIUTYP'>0 D Q
. . W !!,"Item #",TIUI," no longer exists.",!
. . I IO=IO(0),'$D(ZTQUEUED),$$READ^TIUU("EA","RETURN to continue...")
. S ARRAYDA(TIUDA)=""
. ; -- If TIUDA is an addendum, print its parent instead,
. ; or quit if the parent has already been printed: --
. I +$$ISADDNDM^TIULC1(TIUDA) D Q:'TIUDA
. . S TIUDA=+$P($G(^TIU(8925,TIUDA,0)),U,6)
. . I $D(ARRAYDA(TIUDA)) S TIUDA=0 Q
. . S TIUDTYP=+$G(^TIU(8925,TIUDA,0))
. ; -- If TIUDA is an ID kid, print its parent instead,
. ; or quit if the parent has already been printed: --
. I $G(^TIU(8925,TIUDA,21)) D Q:'TIUDA
. . S TIUDA=^TIU(8925,TIUDA,21)
. . I $D(ARRAYDA(TIUDA)) S TIUDA=0 Q
. . S TIUDTYP=+$G(^TIU(8925,TIUDA,0))
. S TIUPRINT=$$CANDO^TIULP(TIUDA,"PRINT RECORD")
. I +TIUPRINT'>0 D Q ; Exclude records user can't print
. . W !!,"Item #",TIUI,": ",!,$P(TIUPRINT,U,2),!
. . I IO=IO(0),'$D(ZTQUEUED),$$READ^TIUU("EA","RETURN to continue...")
. I +$G(TIUPFLG) S TIUFLAG=+$$CHARTONE^TIURA1(TIUDA)
. S DFN=$P($G(^TIU(8925,+TIUDA,0)),U,2)
. I +TIUTYP,'$G(TIUDTYP) D
. . S TIUPMTHD=$$PRNTMTHD^TIULG(+TIUTYP)
. . S TIUPGRP=$$PRNTGRP^TIULG(+TIUTYP)
. . S TIUPFHDR=$$PRNTHDR^TIULG(+TIUTYP)
. . S TIUPFNBR=$$PRNTNBR^TIULG(+TIUTYP)
. I +$G(TIUDTYP) S TIUPMTHD=$$PRNTMTHD^TIULG(+TIUDTYP),TIUPGRP=$$PRNTGRP^TIULG(+TIUDTYP),TIUPFHDR=$$PRNTHDR^TIULG(+TIUDTYP),TIUPFNBR=$$PRNTNBR^TIULG(+TIUDTYP)
. I $G(TIUPMTHD)']"" D Q ; Exclude records lacking print method P182
. . W !!,"Item #",TIUI," has no Print Method.",!
. . I IO=IO(0),'$D(ZTQUEUED),$$READ^TIUU("EA","RETURN to continue...")
. ;I +$G(TIUPGRP),($G(TIUPFHDR)]""),($G(TIUPFNBR)]"") S TIUDARR(TIUPMTHD,$G(TIUPGRP)_"$"_TIUPFHDR_";"_DFN,TIUI,TIUDA)=TIUPFNBR
. ;E S TIUDARR(TIUPMTHD,DFN,TIUI,TIUDA)=""
. ; -- P182: Set array same whether or not flds are defined, with
. ; TIUPGRP piece possibly 0, TIUPFHDR piece possibly null, and
. ; array value TIUPFNBR possibly null.
. S TIUDARR(TIUPMTHD,+$G(TIUPGRP)_"$"_$G(TIUPFHDR)_";"_DFN,TIUI,TIUDA)=$G(TIUPFNBR)
. D:'$D(ZTQUEUED) RESTORE^VALM10(+TIUI)
S TIUPMTHD="" F S TIUPMTHD=$O(TIUDARR(TIUPMTHD)) Q:TIUPMTHD="" D
. D PRNTDOC(TIUPMTHD,.TIUDARR)
Q
PRINT1 ; Print a single document
N TIUDARR,TIUDEV,TIUTYP,DFN,TIUPMTHD,TIUD0,TIUDPRM,TIUFLAG,TIUDTYP
N TIUPGRP,TIUPFHDR,TIUPFNBR,TIUPRINT,POP,TIUTMPDA
D CLEAR^VALM1
S TIUTMPDA=TIUDA
I +$$ISADDNDM^TIULC1(TIUTMPDA) D
. S TIUTMPDA=+$P($G(^TIU(8925,TIUTMPDA,0)),U,6)
. S TIUDTYP=+$G(^TIU(8925,TIUTMPDA,0))
I $G(^TIU(8925,TIUTMPDA,21)) D
. S TIUTMPDA=^TIU(8925,TIUTMPDA,21)
. S TIUDTYP=+$G(^TIU(8925,TIUTMPDA,0))
S TIUPRINT=$$CANDO^TIULP(TIUTMPDA,"PRINT RECORD")
I +TIUPRINT'>0 D Q
. W !!,$C(7),$P(TIUPRINT,U,2),!
. I $$READ^TIUU("EA","RETURN to continue...") ; pause
I +$G(TIUDTYP) D
. S TIUPMTHD=$$PRNTMTHD^TIULG(+TIUDTYP)
. S TIUPGRP=$$PRNTGRP^TIULG(+TIUDTYP)
. S TIUPFHDR=$$PRNTHDR^TIULG(+TIUDTYP)
. S TIUPFNBR=$$PRNTNBR^TIULG(+TIUDTYP)
. D DOCPRM^TIULC1(+TIUDTYP,.TIUDPRM,TIUTMPDA)
S TIUD0=$G(^TIU(8925,TIUTMPDA,0))
S TIUTYP=$P(TIUD0,U),DFN=$P(TIUD0,U,2)
I +TIUTYP'>0 Q
I '$G(TIUDTYP) D
. S TIUPMTHD=$$PRNTMTHD^TIULG(+TIUTYP)
. S TIUPGRP=$$PRNTGRP^TIULG(+TIUTYP)
. S TIUPFHDR=$$PRNTHDR^TIULG(+TIUTYP)
. S TIUPFNBR=$$PRNTNBR^TIULG(+TIUTYP)
. D DOCPRM^TIULC1(+TIUTYP,.TIUDPRM,TIUTMPDA)
I +$P($G(TIUDPRM(0)),U,9) S TIUFLAG=$$FLAG^TIUPRPN3
I (+$P($G(TIUDPRM(0)),U,9)'>0),+$$ISA^USRLM(DUZ,"MEDICAL INFORMATION SECTION") S TIUFLAG=$$FLAG^TIUPRPN3
;I $G(TIUPMTHD)]"",+$G(TIUPGRP),($G(TIUPFHDR)]""),($G(TIUPFNBR)]"") S TIUDARR(TIUPMTHD,$G(TIUPGRP)_"$"_TIUPFHDR_";"_DFN,1,TIUTMPDA)=TIUPFNBR
;E S TIUDARR(TIUPMTHD,DFN,1,TIUTMPDA)=""
I $G(TIUPMTHD)']"" W !,$C(7),"No Print Method Defined for ",$P($G(^TIU(8925.1,+TIUTYP,0)),U) H 2 G PRINT1X
; -- P182: See PRINTN
S TIUDARR(TIUPMTHD,+$G(TIUPGRP)_"$"_$G(TIUPFHDR)_";"_DFN,1,TIUTMPDA)=$G(TIUPFNBR)
S TIUDEV=$$DEVICE^TIUDEV(.IO) ; Get Device
I $S(IO']"":1,TIUDEV']"":1,1:0) G PRINT1X
I $D(IO("Q")) D QUE^TIUDEV("PRINTQ^TIURA",TIUDEV) G PRINT1X
D PRINTQ
PRINT1X D ^%ZISC
Q
PRINTQ ; Queued document print
D PRNTDOC(TIUPMTHD,.TIUDARR)
Q
PRNTDOC(TIUPMTHD,TIUDARR) ; Print docmts w/ Print Method TIUPMTHD in
;array TIUDARR
; Requires TIUPMTHD & TIUDARR
N TIUDA
I '+$D(TIUDARR) W !,"No Documents selected." Q
M ^TMP("TIUPR",$J)=TIUDARR(TIUPMTHD)
I TIUPMTHD']"" D G PRNTDOCX
. W !!,"No Print Method Defined for ",$P(TIUTYP,U,2) H 2
X TIUPMTHD
PRNTDOCX K ^TMP("TIUPR",$J)
Q
BROWS1(TIULTMP) ; -- Call to BROWS1 for backward compatibility
D BROWS1^TIURA2(TIULTMP,TIUDA)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIURA 8664 printed Dec 13, 2024@02:44:58 Page 2
TIURA ; SLC/JER - Review screen actions ; 7/7/04
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1,10,20,79,88,58,100,109,182**;Jun 20, 1997
+2 ; Call to ISA^USRLM supported by DBIA 2324
EDIT ; Edit Documents
+1 NEW TIUDA,DFN,TIUDDT,TIUDATA,TIUCHNG,TIUEDIT,TIUI,DIROUT,TIUDAARY
+2 NEW TIULST,MSGVERB
+3 SET TIUI=0
+4 IF '$DATA(VALMY)
DO EN^VALM2(XQORNOD(0))
+5 FOR
SET TIUI=$ORDER(VALMY(TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+6 NEW RSTRCTD
+7 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
+8 DO CLEAR^VALM1
WRITE !!,"Editing #",+TIUDATA
+9 SET TIUDA=+$PIECE(TIUDATA,U,2)
SET RSTRCTD=$$DOCRES^TIULRR(TIUDA)
+10 IF RSTRCTD
Begin DoDot:2
+11 WRITE !!,$CHAR(7),"Ok, no harm done...",!
+12 ; pause
IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:2
QUIT
+13 SET TIUDAARY(TIUI)=TIUDA
+14 SET TIUCHNG=0
+15 IF +$DATA(^TIU(8925,+TIUDA,0))
DO EDIT1
+16 IF +$GET(TIUCHNG)
Begin DoDot:2
+17 SET TIULST=$GET(TIULST)_$SELECT($GET(TIULST)]"":",",1:"")_TIUI
End DoDot:2
End DoDot:1
if $DATA(DIROUT)
QUIT
+18 ; -- Update or Rebuild list, restore video: --
+19 IF $GET(TIUCHNG("ADDM"))!$GET(TIUCHNG("DELETE"))
SET TIUCHNG("RBLD")=1
+20 IF '$TEST
SET TIUCHNG("UPDATE")=1
+21 DO UPRBLD^TIURL(.TIUCHNG,.VALMY)
KILL VALMY
+22 SET VALMBCK="R"
+23 SET MSGVERB=$SELECT($GET(TIUCHNG("ADDM")):"edited/addended",1:"edited")
+24 DO VMSG^TIURS1($GET(TIULST),.TIUDAARY,MSGVERB)
+25 QUIT
EDIT1 ; Single record edit
+1 ; Receives TIUDA
+2 NEW %X,%Y,C,D,D0,DDWTMP,DFN,DI,DIC,TIUEDIT,TIUMSG,TIUQUIT,TIUADD,TIUREL
+3 NEW TIUTYP,TIUT0,TIUDPRM,TIULDT,DIWESUB,TIU,TIUCMMTX
+4 IF '$DATA(TIUPRM0)!'$DATA(TIUPRM1)
DO SETPARM^TIULE
+5 IF '+$GET(TIUDA)
WRITE !,"No Documents selected."
HANG 2
QUIT
+6 ; Evaluate edit privilege
+7 SET TIUEDIT=$$CANDO^TIULP(TIUDA,"EDIT RECORD")
+8 ; if 'canedit, offer explanation, and let add addendum
+9 IF '+TIUEDIT
Begin DoDot:1
+10 KILL ^TIU(8925,"ASAVE",DUZ,TIUDA)
+11 WRITE !!,$CHAR(7),$PIECE(TIUEDIT,U,2),!
+12 IF $$READ^TIUU("EA","Press RETURN to continue...")
+13 DO ADDENDUM^TIUADD(TIUDA,"",.TIUCHNG)
End DoDot:1
QUIT
+14 SET TIUTYP=+$GET(^TIU(8925,+TIUDA,0))
SET TIUT0=$GET(^TIU(8925.1,+TIUTYP,0))
+15 SET TIUTYP(1)="1^"_+TIUTYP_U_$PIECE(TIUT0,U,3)_U
+16 SET DFN=$PIECE($GET(^TIU(8925,+TIUDA,0)),U,2)
SET TIULDT=$PIECE(^(0),U,8)
+17 DO GETTIU^TIULD(.TIU,TIUDA)
+18 SET DIWESUB="Patient: "_$GET(TIU("PNM"))
+19 ; **100**
DO DIE^TIUEDI4(TIUDA,.TIUQUIT,.TIUCHNG)
+20 KILL ^TIU(8925,"ASAVE",DUZ,TIUDA)
+21 IF +$GET(TIUCPYNG)
IF +$GET(TIUQUIT)
DO DELETE^TIUEDIT(TIUDA,0,"",1)
QUIT
+22 if +$GET(TIUQUIT)=2
QUIT
+23 ;If (CP) and (Timeout or Not Select Consult) and (Consult Associated), Quit before EMPTYDOC check
+24 IF +$$ISA^TIULX(TIUTYP,+$$CLASS^TIUCP)
IF +$GET(TIUQUIT)=1
IF +$PIECE($GET(^TIU(8925,+TIUDA,14)),U,5)>0
QUIT
+25 IF $$EMPTYDOC^TIULF(TIUDA)
DO DELETE^TIUEDIT(TIUDA,0)
SET TIUCHNG("DELETE")=1
HANG 2
QUIT
+26 if +$GET(TIUQUIT)
QUIT
+27 IF +$GET(TIU("STOP"))
DO DEFER^TIUVSIT(TIUDA,TIU("STOP"))
IF 1
+28 IF '$TEST
IF +$PIECE($GET(^TIU(8925,+TIUDA,0)),U,3)'>0
DO QUE^TIUPXAP1
+29 ; - Commit proc -
+30 SET TIUCMMTX=$$COMMIT^TIULC1(+$PIECE(TIUTYP(1),U,2))
+31 IF TIUCMMTX]""
Begin DoDot:1
+32 NEW DA
SET DA=TIUDA
XECUTE TIUCMMTX
End DoDot:1
+33 ; i. Execute RELEASE logic
+34 DO RELEASE^TIUT(+TIUDA)
+35 ; ii. Execute VERIFICATION logic
+36 DO VERIFY^TIUT(+TIUDA)
+37 ; iii. Execute ES logic
+38 DO EDSIG^TIURS(+TIUDA,"",1)
+39 ; iv. If document is an ADDENDUM process alert
+40 IF +$$ISADDNDM^TIULC1(+TIUDA)
DO SENDADD^TIUALRT(+TIUDA)
+41 IF $DATA(^TMP("TIUR",$JOB,"CTXT"))
IF (+$PIECE($GET(^TIU(8925,+TIUDA,0)),U,5)'<6)
SET VALMBCK="Q"
+42 QUIT
PRINT ; Print selected documents
+1 NEW DFN,TIUDA,TIUDARR,TIUDATA,TIUI,DIROUT,TIUDE,POP,TIUPFLG,TIUDEV
+2 IF '$DATA(VALMY)
DO EN^VALM2(XQORNOD(0))
if $DATA(VALMY)'>9
GOTO PRINTX
+3 DO CLEAR^VALM1
+4 DO PRNTSCRN^TIURA2(.VALMY)
+5 IF '$DATA(VALMY)
Begin DoDot:1
+6 WRITE !!,"No Printable Documents Remain in your List.",!
+7 IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:1
GOTO PRINTX
+8 IF +$$CHARTANY^TIURA1(.VALMY)
SET TIUPFLG=$$FLAG^TIUPRPN3
+9 ; Get Device/allow queueing
SET TIUDEV=$$DEVICE^TIUDEV(.IO)
+10 IF $SELECT(IO']"":1,TIUDEV']"":1,1:0)
GOTO PRINTX
+11 IF $DATA(IO("Q"))
DO QUE^TIUDEV("PRINTN^TIURA",TIUDEV)
GOTO PRINTX
+12 DO PRINTN
PRINTX NEW IOSTBM
DO ^%ZISC
DO FIXLSTNW^TIULM
+1 KILL VALMY
SET VALMBCK="R"
+2 QUIT
PRINTN ; Loop through selected doc's & invoke print code
+1 NEW TIUI,TIUTYP,TIUDARR,DFN
KILL ^TMP("TIUPR",$JOB)
+2 NEW ARRAYDA
+3 USE IO
+4 SET TIUI=0
+5 FOR
SET TIUI=$ORDER(VALMY(TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+6 NEW TIUPMTHD,TIUDTYP,TIUPFHDR,TIUPFNBR,TIUPGRP,TIUPRINT,TIUFLAG
+7 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
+8 SET TIUDA=+$PIECE(TIUDATA,U,2)
+9 ;P182
SET TIUTYP=+$GET(^TIU(8925,TIUDA,0))
+10 IF TIUTYP'>0
Begin DoDot:2
+11 WRITE !!,"Item #",TIUI," no longer exists.",!
+12 IF IO=IO(0)
IF '$DATA(ZTQUEUED)
IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:2
QUIT
+13 SET ARRAYDA(TIUDA)=""
+14 ; -- If TIUDA is an addendum, print its parent instead,
+15 ; or quit if the parent has already been printed: --
+16 IF +$$ISADDNDM^TIULC1(TIUDA)
Begin DoDot:2
+17 SET TIUDA=+$PIECE($GET(^TIU(8925,TIUDA,0)),U,6)
+18 IF $DATA(ARRAYDA(TIUDA))
SET TIUDA=0
QUIT
+19 SET TIUDTYP=+$GET(^TIU(8925,TIUDA,0))
End DoDot:2
if 'TIUDA
QUIT
+20 ; -- If TIUDA is an ID kid, print its parent instead,
+21 ; or quit if the parent has already been printed: --
+22 IF $GET(^TIU(8925,TIUDA,21))
Begin DoDot:2
+23 SET TIUDA=^TIU(8925,TIUDA,21)
+24 IF $DATA(ARRAYDA(TIUDA))
SET TIUDA=0
QUIT
+25 SET TIUDTYP=+$GET(^TIU(8925,TIUDA,0))
End DoDot:2
if 'TIUDA
QUIT
+26 SET TIUPRINT=$$CANDO^TIULP(TIUDA,"PRINT RECORD")
+27 ; Exclude records user can't print
IF +TIUPRINT'>0
Begin DoDot:2
+28 WRITE !!,"Item #",TIUI,": ",!,$PIECE(TIUPRINT,U,2),!
+29 IF IO=IO(0)
IF '$DATA(ZTQUEUED)
IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:2
QUIT
+30 IF +$GET(TIUPFLG)
SET TIUFLAG=+$$CHARTONE^TIURA1(TIUDA)
+31 SET DFN=$PIECE($GET(^TIU(8925,+TIUDA,0)),U,2)
+32 IF +TIUTYP
IF '$GET(TIUDTYP)
Begin DoDot:2
+33 SET TIUPMTHD=$$PRNTMTHD^TIULG(+TIUTYP)
+34 SET TIUPGRP=$$PRNTGRP^TIULG(+TIUTYP)
+35 SET TIUPFHDR=$$PRNTHDR^TIULG(+TIUTYP)
+36 SET TIUPFNBR=$$PRNTNBR^TIULG(+TIUTYP)
End DoDot:2
+37 IF +$GET(TIUDTYP)
SET TIUPMTHD=$$PRNTMTHD^TIULG(+TIUDTYP)
SET TIUPGRP=$$PRNTGRP^TIULG(+TIUDTYP)
SET TIUPFHDR=$$PRNTHDR^TIULG(+TIUDTYP)
SET TIUPFNBR=$$PRNTNBR^TIULG(+TIUDTYP)
+38 ; Exclude records lacking print method P182
IF $GET(TIUPMTHD)']""
Begin DoDot:2
+39 WRITE !!,"Item #",TIUI," has no Print Method.",!
+40 IF IO=IO(0)
IF '$DATA(ZTQUEUED)
IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:2
QUIT
+41 ;I +$G(TIUPGRP),($G(TIUPFHDR)]""),($G(TIUPFNBR)]"") S TIUDARR(TIUPMTHD,$G(TIUPGRP)_"$"_TIUPFHDR_";"_DFN,TIUI,TIUDA)=TIUPFNBR
+42 ;E S TIUDARR(TIUPMTHD,DFN,TIUI,TIUDA)=""
+43 ; -- P182: Set array same whether or not flds are defined, with
+44 ; TIUPGRP piece possibly 0, TIUPFHDR piece possibly null, and
+45 ; array value TIUPFNBR possibly null.
+46 SET TIUDARR(TIUPMTHD,+$GET(TIUPGRP)_"$"_$GET(TIUPFHDR)_";"_DFN,TIUI,TIUDA)=$GET(TIUPFNBR)
+47 if '$DATA(ZTQUEUED)
DO RESTORE^VALM10(+TIUI)
End DoDot:1
if $DATA(DIROUT)
QUIT
+48 SET TIUPMTHD=""
FOR
SET TIUPMTHD=$ORDER(TIUDARR(TIUPMTHD))
if TIUPMTHD=""
QUIT
Begin DoDot:1
+49 DO PRNTDOC(TIUPMTHD,.TIUDARR)
End DoDot:1
+50 QUIT
PRINT1 ; Print a single document
+1 NEW TIUDARR,TIUDEV,TIUTYP,DFN,TIUPMTHD,TIUD0,TIUDPRM,TIUFLAG,TIUDTYP
+2 NEW TIUPGRP,TIUPFHDR,TIUPFNBR,TIUPRINT,POP,TIUTMPDA
+3 DO CLEAR^VALM1
+4 SET TIUTMPDA=TIUDA
+5 IF +$$ISADDNDM^TIULC1(TIUTMPDA)
Begin DoDot:1
+6 SET TIUTMPDA=+$PIECE($GET(^TIU(8925,TIUTMPDA,0)),U,6)
+7 SET TIUDTYP=+$GET(^TIU(8925,TIUTMPDA,0))
End DoDot:1
+8 IF $GET(^TIU(8925,TIUTMPDA,21))
Begin DoDot:1
+9 SET TIUTMPDA=^TIU(8925,TIUTMPDA,21)
+10 SET TIUDTYP=+$GET(^TIU(8925,TIUTMPDA,0))
End DoDot:1
+11 SET TIUPRINT=$$CANDO^TIULP(TIUTMPDA,"PRINT RECORD")
+12 IF +TIUPRINT'>0
Begin DoDot:1
+13 WRITE !!,$CHAR(7),$PIECE(TIUPRINT,U,2),!
+14 ; pause
IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:1
QUIT
+15 IF +$GET(TIUDTYP)
Begin DoDot:1
+16 SET TIUPMTHD=$$PRNTMTHD^TIULG(+TIUDTYP)
+17 SET TIUPGRP=$$PRNTGRP^TIULG(+TIUDTYP)
+18 SET TIUPFHDR=$$PRNTHDR^TIULG(+TIUDTYP)
+19 SET TIUPFNBR=$$PRNTNBR^TIULG(+TIUDTYP)
+20 DO DOCPRM^TIULC1(+TIUDTYP,.TIUDPRM,TIUTMPDA)
End DoDot:1
+21 SET TIUD0=$GET(^TIU(8925,TIUTMPDA,0))
+22 SET TIUTYP=$PIECE(TIUD0,U)
SET DFN=$PIECE(TIUD0,U,2)
+23 IF +TIUTYP'>0
QUIT
+24 IF '$GET(TIUDTYP)
Begin DoDot:1
+25 SET TIUPMTHD=$$PRNTMTHD^TIULG(+TIUTYP)
+26 SET TIUPGRP=$$PRNTGRP^TIULG(+TIUTYP)
+27 SET TIUPFHDR=$$PRNTHDR^TIULG(+TIUTYP)
+28 SET TIUPFNBR=$$PRNTNBR^TIULG(+TIUTYP)
+29 DO DOCPRM^TIULC1(+TIUTYP,.TIUDPRM,TIUTMPDA)
End DoDot:1
+30 IF +$PIECE($GET(TIUDPRM(0)),U,9)
SET TIUFLAG=$$FLAG^TIUPRPN3
+31 IF (+$PIECE($GET(TIUDPRM(0)),U,9)'>0)
IF +$$ISA^USRLM(DUZ,"MEDICAL INFORMATION SECTION")
SET TIUFLAG=$$FLAG^TIUPRPN3
+32 ;I $G(TIUPMTHD)]"",+$G(TIUPGRP),($G(TIUPFHDR)]""),($G(TIUPFNBR)]"") S TIUDARR(TIUPMTHD,$G(TIUPGRP)_"$"_TIUPFHDR_";"_DFN,1,TIUTMPDA)=TIUPFNBR
+33 ;E S TIUDARR(TIUPMTHD,DFN,1,TIUTMPDA)=""
+34 IF $GET(TIUPMTHD)']""
WRITE !,$CHAR(7),"No Print Method Defined for ",$PIECE($GET(^TIU(8925.1,+TIUTYP,0)),U)
HANG 2
GOTO PRINT1X
+35 ; -- P182: See PRINTN
+36 SET TIUDARR(TIUPMTHD,+$GET(TIUPGRP)_"$"_$GET(TIUPFHDR)_";"_DFN,1,TIUTMPDA)=$GET(TIUPFNBR)
+37 ; Get Device
SET TIUDEV=$$DEVICE^TIUDEV(.IO)
+38 IF $SELECT(IO']"":1,TIUDEV']"":1,1:0)
GOTO PRINT1X
+39 IF $DATA(IO("Q"))
DO QUE^TIUDEV("PRINTQ^TIURA",TIUDEV)
GOTO PRINT1X
+40 DO PRINTQ
PRINT1X DO ^%ZISC
+1 QUIT
PRINTQ ; Queued document print
+1 DO PRNTDOC(TIUPMTHD,.TIUDARR)
+2 QUIT
PRNTDOC(TIUPMTHD,TIUDARR) ; Print docmts w/ Print Method TIUPMTHD in
+1 ;array TIUDARR
+2 ; Requires TIUPMTHD & TIUDARR
+3 NEW TIUDA
+4 IF '+$DATA(TIUDARR)
WRITE !,"No Documents selected."
QUIT
+5 MERGE ^TMP("TIUPR",$JOB)=TIUDARR(TIUPMTHD)
+6 IF TIUPMTHD']""
Begin DoDot:1
+7 WRITE !!,"No Print Method Defined for ",$PIECE(TIUTYP,U,2)
HANG 2
End DoDot:1
GOTO PRNTDOCX
+8 XECUTE TIUPMTHD
PRNTDOCX KILL ^TMP("TIUPR",$JOB)
+1 QUIT
BROWS1(TIULTMP) ; -- Call to BROWS1 for backward compatibility
+1 DO BROWS1^TIURA2(TIULTMP,TIUDA)
+2 QUIT
