- 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 Jan 18, 2025@03:46:06 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