source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIURA.m@ 1314

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