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