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

TIURA.m

Go to the documentation of this file.
  1. 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
  1. ; Call to ISA^USRLM supported by DBIA 2324
  1. EDIT ; Edit Documents
  1. N TIUDA,DFN,TIUDDT,TIUDATA,TIUCHNG,TIUEDIT,TIUI,DIROUT,TIUDAARY
  1. N TIULST,MSGVERB
  1. S TIUI=0
  1. I '$D(VALMY) D EN^VALM2(XQORNOD(0))
  1. F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
  1. . N RSTRCTD
  1. . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
  1. . D CLEAR^VALM1 W !!,"Editing #",+TIUDATA
  1. . S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
  1. . I RSTRCTD D Q
  1. . . W !!,$C(7),"Ok, no harm done...",!
  1. . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
  1. . S TIUDAARY(TIUI)=TIUDA
  1. . S TIUCHNG=0
  1. . I +$D(^TIU(8925,+TIUDA,0)) D EDIT1
  1. . I +$G(TIUCHNG) D
  1. . . S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
  1. ; -- Update or Rebuild list, restore video: --
  1. I $G(TIUCHNG("ADDM"))!$G(TIUCHNG("DELETE")) S TIUCHNG("RBLD")=1
  1. E S TIUCHNG("UPDATE")=1
  1. D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
  1. S VALMBCK="R"
  1. S MSGVERB=$S($G(TIUCHNG("ADDM")):"edited/addended",1:"edited")
  1. D VMSG^TIURS1($G(TIULST),.TIUDAARY,MSGVERB)
  1. Q
  1. EDIT1 ; Single record edit
  1. ; Receives TIUDA
  1. N %X,%Y,C,D,D0,DDWTMP,DFN,DI,DIC,TIUEDIT,TIUMSG,TIUQUIT,TIUADD,TIUREL
  1. N TIUTYP,TIUT0,TIUDPRM,TIULDT,DIWESUB,TIU,TIUCMMTX
  1. I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
  1. I '+$G(TIUDA) W !,"No Documents selected." H 2 Q
  1. ; Evaluate edit privilege
  1. S TIUEDIT=$$CANDO^TIULP(TIUDA,"EDIT RECORD")
  1. ; if 'canedit, offer explanation, and let add addendum
  1. I '+TIUEDIT D Q
  1. . K ^TIU(8925,"ASAVE",DUZ,TIUDA)
  1. . W !!,$C(7),$P(TIUEDIT,U,2),!
  1. . I $$READ^TIUU("EA","Press RETURN to continue...")
  1. . D ADDENDUM^TIUADD(TIUDA,"",.TIUCHNG)
  1. S TIUTYP=+$G(^TIU(8925,+TIUDA,0)),TIUT0=$G(^TIU(8925.1,+TIUTYP,0))
  1. S TIUTYP(1)="1^"_+TIUTYP_U_$P(TIUT0,U,3)_U
  1. S DFN=$P($G(^TIU(8925,+TIUDA,0)),U,2),TIULDT=$P(^(0),U,8)
  1. D GETTIU^TIULD(.TIU,TIUDA)
  1. S DIWESUB="Patient: "_$G(TIU("PNM"))
  1. D DIE^TIUEDI4(TIUDA,.TIUQUIT,.TIUCHNG) ; **100**
  1. K ^TIU(8925,"ASAVE",DUZ,TIUDA)
  1. I +$G(TIUCPYNG),+$G(TIUQUIT) D DELETE^TIUEDIT(TIUDA,0,"",1) Q
  1. Q:+$G(TIUQUIT)=2
  1. ;If (CP) and (Timeout or Not Select Consult) and (Consult Associated), Quit before EMPTYDOC check
  1. I +$$ISA^TIULX(TIUTYP,+$$CLASS^TIUCP),+$G(TIUQUIT)=1,+$P($G(^TIU(8925,+TIUDA,14)),U,5)>0 Q
  1. I $$EMPTYDOC^TIULF(TIUDA) D DELETE^TIUEDIT(TIUDA,0) S TIUCHNG("DELETE")=1 H 2 Q
  1. Q:+$G(TIUQUIT)
  1. I +$G(TIU("STOP")) D DEFER^TIUVSIT(TIUDA,TIU("STOP")) I 1
  1. E I +$P($G(^TIU(8925,+TIUDA,0)),U,3)'>0 D QUE^TIUPXAP1
  1. ; - Commit proc -
  1. S TIUCMMTX=$$COMMIT^TIULC1(+$P(TIUTYP(1),U,2))
  1. I TIUCMMTX]"" D
  1. . N DA S DA=TIUDA X TIUCMMTX
  1. ; i. Execute RELEASE logic
  1. D RELEASE^TIUT(+TIUDA)
  1. ; ii. Execute VERIFICATION logic
  1. D VERIFY^TIUT(+TIUDA)
  1. ; iii. Execute ES logic
  1. D EDSIG^TIURS(+TIUDA,"",1)
  1. ; iv. If document is an ADDENDUM process alert
  1. I +$$ISADDNDM^TIULC1(+TIUDA) D SENDADD^TIUALRT(+TIUDA)
  1. I $D(^TMP("TIUR",$J,"CTXT")),(+$P($G(^TIU(8925,+TIUDA,0)),U,5)'<6) S VALMBCK="Q"
  1. Q
  1. PRINT ; Print selected documents
  1. N DFN,TIUDA,TIUDARR,TIUDATA,TIUI,DIROUT,TIUDE,POP,TIUPFLG,TIUDEV
  1. I '$D(VALMY) D EN^VALM2(XQORNOD(0)) G:$D(VALMY)'>9 PRINTX
  1. D CLEAR^VALM1
  1. D PRNTSCRN^TIURA2(.VALMY)
  1. I '$D(VALMY) D G PRINTX
  1. . W !!,"No Printable Documents Remain in your List.",!
  1. . I $$READ^TIUU("EA","Press RETURN to continue...")
  1. I +$$CHARTANY^TIURA1(.VALMY) S TIUPFLG=$$FLAG^TIUPRPN3
  1. S TIUDEV=$$DEVICE^TIUDEV(.IO) ; Get Device/allow queueing
  1. I $S(IO']"":1,TIUDEV']"":1,1:0) G PRINTX
  1. I $D(IO("Q")) D QUE^TIUDEV("PRINTN^TIURA",TIUDEV) G PRINTX
  1. D PRINTN
  1. PRINTX N IOSTBM D ^%ZISC,FIXLSTNW^TIULM
  1. K VALMY S VALMBCK="R"
  1. Q
  1. PRINTN ; Loop through selected doc's & invoke print code
  1. N TIUI,TIUTYP,TIUDARR,DFN K ^TMP("TIUPR",$J)
  1. N ARRAYDA
  1. U IO
  1. S TIUI=0
  1. F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
  1. . N TIUPMTHD,TIUDTYP,TIUPFHDR,TIUPFNBR,TIUPGRP,TIUPRINT,TIUFLAG
  1. . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
  1. . S TIUDA=+$P(TIUDATA,U,2)
  1. . S TIUTYP=+$G(^TIU(8925,TIUDA,0)) ;P182
  1. . I TIUTYP'>0 D Q
  1. . . W !!,"Item #",TIUI," no longer exists.",!
  1. . . I IO=IO(0),'$D(ZTQUEUED),$$READ^TIUU("EA","RETURN to continue...")
  1. . S ARRAYDA(TIUDA)=""
  1. . ; -- If TIUDA is an addendum, print its parent instead,
  1. . ; or quit if the parent has already been printed: --
  1. . I +$$ISADDNDM^TIULC1(TIUDA) D Q:'TIUDA
  1. . . S TIUDA=+$P($G(^TIU(8925,TIUDA,0)),U,6)
  1. . . I $D(ARRAYDA(TIUDA)) S TIUDA=0 Q
  1. . . S TIUDTYP=+$G(^TIU(8925,TIUDA,0))
  1. . ; -- If TIUDA is an ID kid, print its parent instead,
  1. . ; or quit if the parent has already been printed: --
  1. . I $G(^TIU(8925,TIUDA,21)) D Q:'TIUDA
  1. . . S TIUDA=^TIU(8925,TIUDA,21)
  1. . . I $D(ARRAYDA(TIUDA)) S TIUDA=0 Q
  1. . . S TIUDTYP=+$G(^TIU(8925,TIUDA,0))
  1. . S TIUPRINT=$$CANDO^TIULP(TIUDA,"PRINT RECORD")
  1. . I +TIUPRINT'>0 D Q ; Exclude records user can't print
  1. . . W !!,"Item #",TIUI,": ",!,$P(TIUPRINT,U,2),!
  1. . . I IO=IO(0),'$D(ZTQUEUED),$$READ^TIUU("EA","RETURN to continue...")
  1. . I +$G(TIUPFLG) S TIUFLAG=+$$CHARTONE^TIURA1(TIUDA)
  1. . S DFN=$P($G(^TIU(8925,+TIUDA,0)),U,2)
  1. . I +TIUTYP,'$G(TIUDTYP) D
  1. . . S TIUPMTHD=$$PRNTMTHD^TIULG(+TIUTYP)
  1. . . S TIUPGRP=$$PRNTGRP^TIULG(+TIUTYP)
  1. . . S TIUPFHDR=$$PRNTHDR^TIULG(+TIUTYP)
  1. . . S TIUPFNBR=$$PRNTNBR^TIULG(+TIUTYP)
  1. . I +$G(TIUDTYP) S TIUPMTHD=$$PRNTMTHD^TIULG(+TIUDTYP),TIUPGRP=$$PRNTGRP^TIULG(+TIUDTYP),TIUPFHDR=$$PRNTHDR^TIULG(+TIUDTYP),TIUPFNBR=$$PRNTNBR^TIULG(+TIUDTYP)
  1. . I $G(TIUPMTHD)']"" D Q ; Exclude records lacking print method P182
  1. . . W !!,"Item #",TIUI," has no Print Method.",!
  1. . . I IO=IO(0),'$D(ZTQUEUED),$$READ^TIUU("EA","RETURN to continue...")
  1. . ;I +$G(TIUPGRP),($G(TIUPFHDR)]""),($G(TIUPFNBR)]"") S TIUDARR(TIUPMTHD,$G(TIUPGRP)_"$"_TIUPFHDR_";"_DFN,TIUI,TIUDA)=TIUPFNBR
  1. . ;E S TIUDARR(TIUPMTHD,DFN,TIUI,TIUDA)=""
  1. . ; -- P182: Set array same whether or not flds are defined, with
  1. . ; TIUPGRP piece possibly 0, TIUPFHDR piece possibly null, and
  1. . ; array value TIUPFNBR possibly null.
  1. . S TIUDARR(TIUPMTHD,+$G(TIUPGRP)_"$"_$G(TIUPFHDR)_";"_DFN,TIUI,TIUDA)=$G(TIUPFNBR)
  1. . D:'$D(ZTQUEUED) RESTORE^VALM10(+TIUI)
  1. S TIUPMTHD="" F S TIUPMTHD=$O(TIUDARR(TIUPMTHD)) Q:TIUPMTHD="" D
  1. . D PRNTDOC(TIUPMTHD,.TIUDARR)
  1. Q
  1. PRINT1 ; Print a single document
  1. N TIUDARR,TIUDEV,TIUTYP,DFN,TIUPMTHD,TIUD0,TIUDPRM,TIUFLAG,TIUDTYP
  1. N TIUPGRP,TIUPFHDR,TIUPFNBR,TIUPRINT,POP,TIUTMPDA
  1. D CLEAR^VALM1
  1. S TIUTMPDA=TIUDA
  1. I +$$ISADDNDM^TIULC1(TIUTMPDA) D
  1. . S TIUTMPDA=+$P($G(^TIU(8925,TIUTMPDA,0)),U,6)
  1. . S TIUDTYP=+$G(^TIU(8925,TIUTMPDA,0))
  1. I $G(^TIU(8925,TIUTMPDA,21)) D
  1. . S TIUTMPDA=^TIU(8925,TIUTMPDA,21)
  1. . S TIUDTYP=+$G(^TIU(8925,TIUTMPDA,0))
  1. S TIUPRINT=$$CANDO^TIULP(TIUTMPDA,"PRINT RECORD")
  1. I +TIUPRINT'>0 D Q
  1. . W !!,$C(7),$P(TIUPRINT,U,2),!
  1. . I $$READ^TIUU("EA","RETURN to continue...") ; pause
  1. I +$G(TIUDTYP) D
  1. . S TIUPMTHD=$$PRNTMTHD^TIULG(+TIUDTYP)
  1. . S TIUPGRP=$$PRNTGRP^TIULG(+TIUDTYP)
  1. . S TIUPFHDR=$$PRNTHDR^TIULG(+TIUDTYP)
  1. . S TIUPFNBR=$$PRNTNBR^TIULG(+TIUDTYP)
  1. . D DOCPRM^TIULC1(+TIUDTYP,.TIUDPRM,TIUTMPDA)
  1. S TIUD0=$G(^TIU(8925,TIUTMPDA,0))
  1. S TIUTYP=$P(TIUD0,U),DFN=$P(TIUD0,U,2)
  1. I +TIUTYP'>0 Q
  1. I '$G(TIUDTYP) D
  1. . S TIUPMTHD=$$PRNTMTHD^TIULG(+TIUTYP)
  1. . S TIUPGRP=$$PRNTGRP^TIULG(+TIUTYP)
  1. . S TIUPFHDR=$$PRNTHDR^TIULG(+TIUTYP)
  1. . S TIUPFNBR=$$PRNTNBR^TIULG(+TIUTYP)
  1. . D DOCPRM^TIULC1(+TIUTYP,.TIUDPRM,TIUTMPDA)
  1. I +$P($G(TIUDPRM(0)),U,9) S TIUFLAG=$$FLAG^TIUPRPN3
  1. I (+$P($G(TIUDPRM(0)),U,9)'>0),+$$ISA^USRLM(DUZ,"MEDICAL INFORMATION SECTION") S TIUFLAG=$$FLAG^TIUPRPN3
  1. ;I $G(TIUPMTHD)]"",+$G(TIUPGRP),($G(TIUPFHDR)]""),($G(TIUPFNBR)]"") S TIUDARR(TIUPMTHD,$G(TIUPGRP)_"$"_TIUPFHDR_";"_DFN,1,TIUTMPDA)=TIUPFNBR
  1. ;E S TIUDARR(TIUPMTHD,DFN,1,TIUTMPDA)=""
  1. I $G(TIUPMTHD)']"" W !,$C(7),"No Print Method Defined for ",$P($G(^TIU(8925.1,+TIUTYP,0)),U) H 2 G PRINT1X
  1. ; -- P182: See PRINTN
  1. S TIUDARR(TIUPMTHD,+$G(TIUPGRP)_"$"_$G(TIUPFHDR)_";"_DFN,1,TIUTMPDA)=$G(TIUPFNBR)
  1. S TIUDEV=$$DEVICE^TIUDEV(.IO) ; Get Device
  1. I $S(IO']"":1,TIUDEV']"":1,1:0) G PRINT1X
  1. I $D(IO("Q")) D QUE^TIUDEV("PRINTQ^TIURA",TIUDEV) G PRINT1X
  1. D PRINTQ
  1. PRINT1X D ^%ZISC
  1. Q
  1. PRINTQ ; Queued document print
  1. D PRNTDOC(TIUPMTHD,.TIUDARR)
  1. Q
  1. PRNTDOC(TIUPMTHD,TIUDARR) ; Print docmts w/ Print Method TIUPMTHD in
  1. ;array TIUDARR
  1. ; Requires TIUPMTHD & TIUDARR
  1. N TIUDA
  1. I '+$D(TIUDARR) W !,"No Documents selected." Q
  1. M ^TMP("TIUPR",$J)=TIUDARR(TIUPMTHD)
  1. I TIUPMTHD']"" D G PRNTDOCX
  1. . W !!,"No Print Method Defined for ",$P(TIUTYP,U,2) H 2
  1. X TIUPMTHD
  1. PRNTDOCX K ^TMP("TIUPR",$J)
  1. Q
  1. BROWS1(TIULTMP) ; -- Call to BROWS1 for backward compatibility
  1. D BROWS1^TIURA2(TIULTMP,TIUDA)
  1. Q