ORCNOTE ; SLC/MKB - Progress Note actions ;Aug 24, 2021@09:58:32
;;3.0;ORDER ENTRY/RESULTS REPORTING;**22,48,65,104,280,370,539,568**;Dec 17, 1997;Build 4
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; External Reference
; #2937 ^TUI(8925
; #10089 ^%ZISC
; #3002 $$DEVICE^TIUDEV, QUE^TIUDEV
; #3001 $$ASKSIG^TIULA1
; #2323 $$ISADDNDM^TIULC1, $$PNAME^TIULC1, $$PTNAME^TIULC1
; #2863 SETPARM^TIULE
; #4426 $$EMPTYDOC^TIULF
; #3003 $$PRNTGRP^TIULG, $$PRNTHDR^TIULG,
; $$PRNTMTHD^TIULG, $$PRNTNBR^TIULG
; #3000 FIXLST^TIULM
; #2322 $$CANDO^TIULP, $$REQCOSIG^TIULP
; #2999 $$FLAG^TIUPRPN3
; #2998 BROWS1^TIURA, EDIT1^TIURA, PRNTDOC^TIURA
; #2694 $$CHARTONE^TIURA1, ADDEND1^TIURA1, SIGNER^TIURA1
; #2997 DEL^TIURB
; #2996 COPY1^TIURC
; #2995 $$ASKCSNR^TIURS, EDSIG^TIURS, ES^TIURS
; #3441 $$HASDAD^TIUSRVLI
; #2994 $$READ^TIUU
; #10118 EN^VALM
; #10116 CLEAR^VALM1, FULL^VALM1
;
ELSIG ; Sign rec
N ASK,TIUEVNT,TIUDA,TIUES,TIUI,X,X1,Y,ORI,NMBR,ORPICK,ORQUIT,IDX,TIUPOP,TIUPRM0,TIUPRM1
I '$D(TIUPRM0) D SETPARM^TIULE
I $P(TIUPRM0,U,2)'>0 W !,"Electronic signature not yet enabled." H 3 G ELSIGX
S ORPICK="",VALMBCK=""
I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("sign") Q:'ORNMBR
I +ORNMBR D FULL^VALM1
S ORI=1
F S NMBR=$P(ORNMBR,",",ORI) Q:+NMBR'>0!$D(ORQUIT) D
. N TIU0,TIU12,TIU15,TIUSTAT,TIUEVNT,TIUTYPE,TIUDA
. S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR)),ORI=+$G(ORI)+1
. S TIUDA=+IDX,TIU0=$G(^TIU(8925,+TIUDA,0)),TIU12=$G(^(12)),TIU15=$G(^(15))
. S TIUSTAT=+$P(TIU0,U,5)
. S TIUTYPE=$$PNAME^TIULC1(+$G(^TIU(8925,+TIUDA,0)))
. S TIUEVNT=$S(+TIUSTAT'>5:"SIGNATURE",1:"COSIGNATURE")
. S ASK=$$CANDO^TIULP(TIUDA,TIUEVNT)
. I +ASK>0 D
. . L +^TIU(8925,+TIUDA):1
. . E S ASK="0^ Another user is editing this entry."
. I +ASK'>0,$P(ASK,U,2)]"" D I 1
. . D FULL^VALM1
. . W !!,"Item #: ",NMBR,!,$P(ASK,U,2),!
. . W !,"Removed from signature list.",!
. . I $$READ^TIUU("FOA","Press RETURN to continue...")
. E D
. . I $S(+$$REQCOSIG^TIULP(+TIU0,+TIUDA,DUZ):1,+$P(TIU15,U,6):1,1:0),(+$P(TIU12,U,8)'>0) D Q:+$G(TIUPOP)
. . . N COSIGNER
. . . W !!,"Item #",NMBR,": ",TIUTYPE," for "
. . . W $$PTNAME^TIULC1($P(TIU0,U,2))," will need cosignature..."
. . . S COSIGNER=$$ASKCSNR^TIURS(TIUDA,DUZ)
. . . I +COSIGNER'>0 D
. . . . S TIUPOP=1
. . . . W !!,"Item #",NMBR,": MUST have a cosigner, before you may sign."
. . . . W !!,"Removed from signature list.",!
. . . . I $$READ^TIUU("FOA","Press RETURN to continue...")
. . ; OR*3.0*370 DJH Do not allow notes without any text to be signed
. . I $$EMPTYDOC^TIULF(+TIUDA) D Q
. . . W !!,"Item #",NMBR,": This note contains no text and cannot be signed."
. . . W !!,"Removed from signature list.",!
. . . I $$READ^TIUU("FOA","Press RETURN to continue...")
. . N TIU,TIUY
. . D EN^VALM("ORC TIU SIGN/COSIGN")
I +$G(ORPICK)'>0 D G ELSIGX
. S VALMSG="** Signature List Empty...Nothing signed. **"
I +$G(ORPICK)>0 D
. S TIUES=$$ASKSIG^TIULA1
. I '+TIUES S VALMSG="** Nothing Signed. **" Q
. F ORI=1:1:$L(ORPICK,",") S NMBR=$P(ORPICK,",",ORI) D:NMBR Q:$D(ORQUIT)
. . S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR)),TIUDA=+IDX
. . D ES^TIURS(TIUDA,TIUES,NMBR)
I $G(ORPICK)']"" S VALMSG="** Nothing Signed. **"
E S VALMSG="** Item"_$S($L(ORPICK,",")>1:"s ",1:" ")_ORPICK_" Signed. **"
ELSIGX K VALMY S VALMBCK="R"
Q
ACCEPT(ORPICK,NMBR) ; Adds item(s) to signature list
D FULL^VALM1
S ORPICK=$G(ORPICK)_$S($L(ORPICK):",",1:"")_NMBR,OREBUILD=1
W !,"Item #",NMBR," added to the signature list." H 3
Q
SIGN ; -- sign notes
N ORI,NMBR,ORQUIT,IDX,TIUDA S VALMBCK=""
I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("sign") Q:'ORNMBR
F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
. S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
. S TIUDA=+IDX Q:'+TIUDA
. D EDSIG^TIURS(TIUDA,"",1)
Q
;
ADDENDUM ; -- make addendum
N ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG S VALMBCK=""
I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("") Q:'ORNMBR
F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
. S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
. S TIUDA=+IDX Q:'+TIUDA
. I +$$ISADDNDM^TIULC1(TIUDA) D Q
. . W !,$C(7),"You may not make addenda to addenda."
. . I $$READ^TIUU("EA","Press RETURN to continue...") W ""
. D CLEAR^VALM1,ADDEND1^TIURA1 I +$G(TIUCHNG) S OREBUILD=1
. I '+$G(TIUCHNG) S VALMBCK="R"
Q
;
EDIT ; -- edit notes
N ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG S VALMBCK=""
I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("edit") Q:'ORNMBR
F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
. S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
. S TIUDA=+IDX Q:'+TIUDA
. D CLEAR^VALM1,EDIT1^TIURA I +$G(TIUCHNG) S OREBUILD=1
S VALMBCK="R"
Q
COPY ; -- copy notes
N ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG,ORTAB S VALMBCK=""
I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("copy") Q:'ORNMBR
F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
. S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
. S TIUDA=+IDX Q:'+TIUDA
. D COPY1^TIURC I +$G(TIUCHNG) S OREBUILD=1
. I '+$G(TIUCHNG) S VALMBCK="R"
Q
DELETE ; -- delete notes
N ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG S VALMBCK=""
I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("delete") Q:'ORNMBR
F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
. S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
. S TIUDA=+IDX Q:'+TIUDA
. D DEL^TIURB(TIUDA) I +$G(TIUCHNG) S OREBUILD=1
Q
SIGNERS ; -- Identify additional signers
N ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG S VALMBCK=""
I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("") Q:'ORNMBR
F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
. S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
. S TIUDA=+IDX Q:'+TIUDA
. D FULL^VALM1,SIGNER^TIURA1
S VALMBCK="R"
Q
PRINT ; Print selected documents
N DFN,TIUDA,TIUDPRM,TIUDARR,TIUDATA,TIUI,DIROUT,TIUDE,POP,TIUPFLG
N TIUSPG,TIUDEV
S VALMBCK="" I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("print") Q:'ORNMBR
D CLEAR^VALM1
I +$$CHARTANY(ORNMBR) S TIUPFLG=$$FLAG^TIUPRPN3
S TIUSPG=1
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^ORCNOTE",TIUDEV) G PRINTX
D PRINTN
PRINTX N IOSTBM D ^%ZISC,FIXLST^TIULM
K VALMY S VALMBCK="R"
Q
CHARTANY(ORNMBR) ; Evaluate selected documents for chart print
N ORI,NMBR,ORSLT S ORSLT=0
F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) Q:+NMBR'>0!+ORSLT D
. N IDX,TIUDA
. S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
. S TIUDA=+IDX Q:'TIUDA
. S ORSLT=+$$CHARTONE^TIURA1(TIUDA)
Q ORSLT
PRINTN ; Loop through selected doc's & invoke print code as appropriate
N TIUI,TIUTYP,ORINDX,ORY,DFN K ^TMP("TIUPR",$J)
N ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG
U IO
F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)!$D(DIROUT)
. N TIUPMTHD,TIUTYP,TIUPFHDR,TIUPFNBR,TIUPGRP,TIUPRINT,TIUDTYP,TIUFLAG
. S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
. S TIUDA=+IDX Q:'+TIUDA Q:'$D(^TIU(8925,TIUDA,0))
. S TIUTYP=$P($G(^TIU(8925,TIUDA,0)),U)
. ; Evaluate whether user can print record
. S TIUPRINT=$$CANDO^TIULP(TIUDA,"PRINT RECORD")
. I +TIUPRINT'>0 D Q ; Exclude records user can't print
. . W !!,"Item #",ORI,": ",!,$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 D
. . S TIUPMTHD=$$PRNTMTHD^TIULG(+TIUTYP)
. . S TIUPGRP=$$PRNTGRP^TIULG(+TIUTYP)
. . S TIUPFHDR=$$PRNTHDR^TIULG(+TIUTYP)
. . S TIUPFNBR=$$PRNTNBR^TIULG(+TIUTYP)
. I +$$ISADDNDM^TIULC1(TIUDA) D
. . S TIUDA=+$P($G(^TIU(8925,TIUDA,0)),U,6)
. . S TIUDTYP=+$G(^TIU(8925,TIUDA,0))
. I +$G(^TIU(8925,TIUDA,21))>0 D
. . S TIUDA=+$G(^TIU(8925,TIUDA,21))
. . S TIUDTYP=+$G(^TIU(8925,TIUDA,0))
. Q:+$D(ORINDX(TIUDA))
. I +$G(TIUDTYP)>0 D
. . S TIUPMTHD=$$PRNTMTHD^TIULG(+TIUDTYP)
. . S TIUPGRP=$$PRNTGRP^TIULG(+TIUDTYP)
. . S TIUPFHDR=$$PRNTHDR^TIULG(+TIUDTYP)
. . S TIUPFNBR=$$PRNTNBR^TIULG(+TIUDTYP)
. I $G(TIUPMTHD)]"",+$G(TIUPGRP),($G(TIUPFHDR)]""),($G(TIUPFNBR)]"") S ORY(TIUPMTHD,$G(TIUPGRP)_"$"_TIUPFHDR_";"_DFN,ORI,TIUDA)=TIUPFNBR
. E S ORY(TIUPMTHD,DFN,ORI,TIUDA)=""
. S ORINDX(TIUDA)=ORI
S TIUPMTHD="" F S TIUPMTHD=$O(ORY(TIUPMTHD)) Q:TIUPMTHD="" D
. D PRNTDOC^TIURA(TIUPMTHD,.ORY)
Q
BROWSE ; -- browse document
N ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG,TIUQUIT S VALMBCK=""
I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("browse") Q:'ORNMBR
F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
. S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
. S TIUDA=+IDX Q:'+TIUDA
. D CLEAR^VALM1,BROWS1^TIURA("TIU BROWSE FOR CLINICIAN")
. S VALMBCK="R" S:+$G(TIUCHNG) OREBUILD=1
. I +$G(TIUQUIT) S ORQUIT=1
Q
;
EX ; -- exit action
D:$G(OREBUILD) TAB^ORCHART(ORTAB,1)
S:$D(^TMP("OR",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
Q
GETTOT(ORY,DFN) ; --get total count of signed progress notes, not
; counting addendums and child interdisciplinary notes
; ^TIU(8925,"ACLPT",3) refers to progress notes class
N ORTIDT,ORTIFN
S ORY=0
Q:'$G(DFN)
F ORTIDT=0:0 S ORTIDT=$O(^TIU(8925,"ACLPT",3,DFN,ORTIDT)) Q:ORTIDT<1 D
.F ORTIFN=0:0 S ORTIFN=$O(^TIU(8925,"ACLPT",3,DFN,ORTIDT,ORTIFN)) Q:ORTIFN<1 D
..S ORY=ORY+1
..Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCNOTE 9551 printed Dec 13, 2024@02:28:48 Page 2
ORCNOTE ; SLC/MKB - Progress Note actions ;Aug 24, 2021@09:58:32
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**22,48,65,104,280,370,539,568**;Dec 17, 1997;Build 4
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; External Reference
+5 ; #2937 ^TUI(8925
+6 ; #10089 ^%ZISC
+7 ; #3002 $$DEVICE^TIUDEV, QUE^TIUDEV
+8 ; #3001 $$ASKSIG^TIULA1
+9 ; #2323 $$ISADDNDM^TIULC1, $$PNAME^TIULC1, $$PTNAME^TIULC1
+10 ; #2863 SETPARM^TIULE
+11 ; #4426 $$EMPTYDOC^TIULF
+12 ; #3003 $$PRNTGRP^TIULG, $$PRNTHDR^TIULG,
+13 ; $$PRNTMTHD^TIULG, $$PRNTNBR^TIULG
+14 ; #3000 FIXLST^TIULM
+15 ; #2322 $$CANDO^TIULP, $$REQCOSIG^TIULP
+16 ; #2999 $$FLAG^TIUPRPN3
+17 ; #2998 BROWS1^TIURA, EDIT1^TIURA, PRNTDOC^TIURA
+18 ; #2694 $$CHARTONE^TIURA1, ADDEND1^TIURA1, SIGNER^TIURA1
+19 ; #2997 DEL^TIURB
+20 ; #2996 COPY1^TIURC
+21 ; #2995 $$ASKCSNR^TIURS, EDSIG^TIURS, ES^TIURS
+22 ; #3441 $$HASDAD^TIUSRVLI
+23 ; #2994 $$READ^TIUU
+24 ; #10118 EN^VALM
+25 ; #10116 CLEAR^VALM1, FULL^VALM1
+26 ;
ELSIG ; Sign rec
+1 NEW ASK,TIUEVNT,TIUDA,TIUES,TIUI,X,X1,Y,ORI,NMBR,ORPICK,ORQUIT,IDX,TIUPOP,TIUPRM0,TIUPRM1
+2 IF '$DATA(TIUPRM0)
DO SETPARM^TIULE
+3 IF $PIECE(TIUPRM0,U,2)'>0
WRITE !,"Electronic signature not yet enabled."
HANG 3
GOTO ELSIGX
+4 SET ORPICK=""
SET VALMBCK=""
+5 IF '$GET(ORNMBR)
SET ORNMBR=$$ORDERS^ORCHART("sign")
if 'ORNMBR
QUIT
+6 IF +ORNMBR
DO FULL^VALM1
+7 SET ORI=1
+8 FOR
SET NMBR=$PIECE(ORNMBR,",",ORI)
if +NMBR'>0!$DATA(ORQUIT)
QUIT
Begin DoDot:1
+9 NEW TIU0,TIU12,TIU15,TIUSTAT,TIUEVNT,TIUTYPE,TIUDA
+10 SET IDX=$GET(^TMP("OR",$JOB,"CURRENT","IDX",NMBR))
SET ORI=+$GET(ORI)+1
+11 SET TIUDA=+IDX
SET TIU0=$GET(^TIU(8925,+TIUDA,0))
SET TIU12=$GET(^(12))
SET TIU15=$GET(^(15))
+12 SET TIUSTAT=+$PIECE(TIU0,U,5)
+13 SET TIUTYPE=$$PNAME^TIULC1(+$GET(^TIU(8925,+TIUDA,0)))
+14 SET TIUEVNT=$SELECT(+TIUSTAT'>5:"SIGNATURE",1:"COSIGNATURE")
+15 SET ASK=$$CANDO^TIULP(TIUDA,TIUEVNT)
+16 IF +ASK>0
Begin DoDot:2
+17 LOCK +^TIU(8925,+TIUDA):1
+18 IF '$TEST
SET ASK="0^ Another user is editing this entry."
End DoDot:2
+19 IF +ASK'>0
IF $PIECE(ASK,U,2)]""
Begin DoDot:2
+20 DO FULL^VALM1
+21 WRITE !!,"Item #: ",NMBR,!,$PIECE(ASK,U,2),!
+22 WRITE !,"Removed from signature list.",!
+23 IF $$READ^TIUU("FOA","Press RETURN to continue...")
End DoDot:2
IF 1
+24 IF '$TEST
Begin DoDot:2
+25 IF $SELECT(+$$REQCOSIG^TIULP(+TIU0,+TIUDA,DUZ):1,+$PIECE(TIU15,U,6):1,1:0)
IF (+$PIECE(TIU12,U,8)'>0)
Begin DoDot:3
+26 NEW COSIGNER
+27 WRITE !!,"Item #",NMBR,": ",TIUTYPE," for "
+28 WRITE $$PTNAME^TIULC1($PIECE(TIU0,U,2))," will need cosignature..."
+29 SET COSIGNER=$$ASKCSNR^TIURS(TIUDA,DUZ)
+30 IF +COSIGNER'>0
Begin DoDot:4
+31 SET TIUPOP=1
+32 WRITE !!,"Item #",NMBR,": MUST have a cosigner, before you may sign."
+33 WRITE !!,"Removed from signature list.",!
+34 IF $$READ^TIUU("FOA","Press RETURN to continue...")
End DoDot:4
End DoDot:3
if +$GET(TIUPOP)
QUIT
+35 ; OR*3.0*370 DJH Do not allow notes without any text to be signed
+36 IF $$EMPTYDOC^TIULF(+TIUDA)
Begin DoDot:3
+37 WRITE !!,"Item #",NMBR,": This note contains no text and cannot be signed."
+38 WRITE !!,"Removed from signature list.",!
+39 IF $$READ^TIUU("FOA","Press RETURN to continue...")
End DoDot:3
QUIT
+40 NEW TIU,TIUY
+41 DO EN^VALM("ORC TIU SIGN/COSIGN")
End DoDot:2
End DoDot:1
+42 IF +$GET(ORPICK)'>0
Begin DoDot:1
+43 SET VALMSG="** Signature List Empty...Nothing signed. **"
End DoDot:1
GOTO ELSIGX
+44 IF +$GET(ORPICK)>0
Begin DoDot:1
+45 SET TIUES=$$ASKSIG^TIULA1
+46 IF '+TIUES
SET VALMSG="** Nothing Signed. **"
QUIT
+47 FOR ORI=1:1:$LENGTH(ORPICK,",")
SET NMBR=$PIECE(ORPICK,",",ORI)
if NMBR
Begin DoDot:2
+48 SET IDX=$GET(^TMP("OR",$JOB,"CURRENT","IDX",NMBR))
SET TIUDA=+IDX
+49 DO ES^TIURS(TIUDA,TIUES,NMBR)
End DoDot:2
if $DATA(ORQUIT)
QUIT
End DoDot:1
+50 IF $GET(ORPICK)']""
SET VALMSG="** Nothing Signed. **"
+51 IF '$TEST
SET VALMSG="** Item"_$SELECT($LENGTH(ORPICK,",")>1:"s ",1:" ")_ORPICK_" Signed. **"
ELSIGX KILL VALMY
SET VALMBCK="R"
+1 QUIT
ACCEPT(ORPICK,NMBR) ; Adds item(s) to signature list
+1 DO FULL^VALM1
+2 SET ORPICK=$GET(ORPICK)_$SELECT($LENGTH(ORPICK):",",1:"")_NMBR
SET OREBUILD=1
+3 WRITE !,"Item #",NMBR," added to the signature list."
HANG 3
+4 QUIT
SIGN ; -- sign notes
+1 NEW ORI,NMBR,ORQUIT,IDX,TIUDA
SET VALMBCK=""
+2 IF '$GET(ORNMBR)
SET ORNMBR=$$ORDERS^ORCHART("sign")
if 'ORNMBR
QUIT
+3 FOR ORI=1:1:$LENGTH(ORNMBR,",")
SET NMBR=$PIECE(ORNMBR,",",ORI)
if NMBR
Begin DoDot:1
+4 SET IDX=$GET(^TMP("OR",$JOB,"CURRENT","IDX",NMBR))
+5 SET TIUDA=+IDX
if '+TIUDA
QUIT
+6 DO EDSIG^TIURS(TIUDA,"",1)
End DoDot:1
if $DATA(ORQUIT)
QUIT
+7 QUIT
+8 ;
ADDENDUM ; -- make addendum
+1 NEW ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG
SET VALMBCK=""
+2 IF '$GET(ORNMBR)
SET ORNMBR=$$ORDERS^ORCHART("")
if 'ORNMBR
QUIT
+3 FOR ORI=1:1:$LENGTH(ORNMBR,",")
SET NMBR=$PIECE(ORNMBR,",",ORI)
if NMBR
Begin DoDot:1
+4 SET IDX=$GET(^TMP("OR",$JOB,"CURRENT","IDX",NMBR))
+5 SET TIUDA=+IDX
if '+TIUDA
QUIT
+6 IF +$$ISADDNDM^TIULC1(TIUDA)
Begin DoDot:2
+7 WRITE !,$CHAR(7),"You may not make addenda to addenda."
+8 IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:2
QUIT
+9 DO CLEAR^VALM1
DO ADDEND1^TIURA1
IF +$GET(TIUCHNG)
SET OREBUILD=1
+10 IF '+$GET(TIUCHNG)
SET VALMBCK="R"
End DoDot:1
if $DATA(ORQUIT)
QUIT
+11 QUIT
+12 ;
EDIT ; -- edit notes
+1 NEW ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG
SET VALMBCK=""
+2 IF '$GET(ORNMBR)
SET ORNMBR=$$ORDERS^ORCHART("edit")
if 'ORNMBR
QUIT
+3 FOR ORI=1:1:$LENGTH(ORNMBR,",")
SET NMBR=$PIECE(ORNMBR,",",ORI)
if NMBR
Begin DoDot:1
+4 SET IDX=$GET(^TMP("OR",$JOB,"CURRENT","IDX",NMBR))
+5 SET TIUDA=+IDX
if '+TIUDA
QUIT
+6 DO CLEAR^VALM1
DO EDIT1^TIURA
IF +$GET(TIUCHNG)
SET OREBUILD=1
End DoDot:1
if $DATA(ORQUIT)
QUIT
+7 SET VALMBCK="R"
+8 QUIT
COPY ; -- copy notes
+1 NEW ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG,ORTAB
SET VALMBCK=""
+2 IF '$GET(ORNMBR)
SET ORNMBR=$$ORDERS^ORCHART("copy")
if 'ORNMBR
QUIT
+3 FOR ORI=1:1:$LENGTH(ORNMBR,",")
SET NMBR=$PIECE(ORNMBR,",",ORI)
if NMBR
Begin DoDot:1
+4 SET IDX=$GET(^TMP("OR",$JOB,"CURRENT","IDX",NMBR))
+5 SET TIUDA=+IDX
if '+TIUDA
QUIT
+6 DO COPY1^TIURC
IF +$GET(TIUCHNG)
SET OREBUILD=1
+7 IF '+$GET(TIUCHNG)
SET VALMBCK="R"
End DoDot:1
if $DATA(ORQUIT)
QUIT
+8 QUIT
DELETE ; -- delete notes
+1 NEW ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG
SET VALMBCK=""
+2 IF '$GET(ORNMBR)
SET ORNMBR=$$ORDERS^ORCHART("delete")
if 'ORNMBR
QUIT
+3 FOR ORI=1:1:$LENGTH(ORNMBR,",")
SET NMBR=$PIECE(ORNMBR,",",ORI)
if NMBR
Begin DoDot:1
+4 SET IDX=$GET(^TMP("OR",$JOB,"CURRENT","IDX",NMBR))
+5 SET TIUDA=+IDX
if '+TIUDA
QUIT
+6 DO DEL^TIURB(TIUDA)
IF +$GET(TIUCHNG)
SET OREBUILD=1
End DoDot:1
if $DATA(ORQUIT)
QUIT
+7 QUIT
SIGNERS ; -- Identify additional signers
+1 NEW ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG
SET VALMBCK=""
+2 IF '$GET(ORNMBR)
SET ORNMBR=$$ORDERS^ORCHART("")
if 'ORNMBR
QUIT
+3 FOR ORI=1:1:$LENGTH(ORNMBR,",")
SET NMBR=$PIECE(ORNMBR,",",ORI)
if NMBR
Begin DoDot:1
+4 SET IDX=$GET(^TMP("OR",$JOB,"CURRENT","IDX",NMBR))
+5 SET TIUDA=+IDX
if '+TIUDA
QUIT
+6 DO FULL^VALM1
DO SIGNER^TIURA1
End DoDot:1
if $DATA(ORQUIT)
QUIT
+7 SET VALMBCK="R"
+8 QUIT
PRINT ; Print selected documents
+1 NEW DFN,TIUDA,TIUDPRM,TIUDARR,TIUDATA,TIUI,DIROUT,TIUDE,POP,TIUPFLG
+2 NEW TIUSPG,TIUDEV
+3 SET VALMBCK=""
IF '$GET(ORNMBR)
SET ORNMBR=$$ORDERS^ORCHART("print")
if 'ORNMBR
QUIT
+4 DO CLEAR^VALM1
+5 IF +$$CHARTANY(ORNMBR)
SET TIUPFLG=$$FLAG^TIUPRPN3
+6 SET TIUSPG=1
+7 ; Get Device/allow queueing
SET TIUDEV=$$DEVICE^TIUDEV(.IO)
+8 IF $SELECT(IO']"":1,TIUDEV']"":1,1:0)
GOTO PRINTX
+9 IF $DATA(IO("Q"))
DO QUE^TIUDEV("PRINTN^ORCNOTE",TIUDEV)
GOTO PRINTX
+10 DO PRINTN
PRINTX NEW IOSTBM
DO ^%ZISC
DO FIXLST^TIULM
+1 KILL VALMY
SET VALMBCK="R"
+2 QUIT
CHARTANY(ORNMBR) ; Evaluate selected documents for chart print
+1 NEW ORI,NMBR,ORSLT
SET ORSLT=0
+2 FOR ORI=1:1:$LENGTH(ORNMBR,",")
SET NMBR=$PIECE(ORNMBR,",",ORI)
if +NMBR'>0!+ORSLT
QUIT
Begin DoDot:1
+3 NEW IDX,TIUDA
+4 SET IDX=$GET(^TMP("OR",$JOB,"CURRENT","IDX",NMBR))
+5 SET TIUDA=+IDX
if 'TIUDA
QUIT
+6 SET ORSLT=+$$CHARTONE^TIURA1(TIUDA)
End DoDot:1
+7 QUIT ORSLT
PRINTN ; Loop through selected doc's & invoke print code as appropriate
+1 NEW TIUI,TIUTYP,ORINDX,ORY,DFN
KILL ^TMP("TIUPR",$JOB)
+2 NEW ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG
+3 USE IO
+4 FOR ORI=1:1:$LENGTH(ORNMBR,",")
SET NMBR=$PIECE(ORNMBR,",",ORI)
if NMBR
Begin DoDot:1
+5 NEW TIUPMTHD,TIUTYP,TIUPFHDR,TIUPFNBR,TIUPGRP,TIUPRINT,TIUDTYP,TIUFLAG
+6 SET IDX=$GET(^TMP("OR",$JOB,"CURRENT","IDX",NMBR))
+7 SET TIUDA=+IDX
if '+TIUDA
QUIT
if '$DATA(^TIU(8925,TIUDA,0))
QUIT
+8 SET TIUTYP=$PIECE($GET(^TIU(8925,TIUDA,0)),U)
+9 ; Evaluate whether user can print record
+10 SET TIUPRINT=$$CANDO^TIULP(TIUDA,"PRINT RECORD")
+11 ; Exclude records user can't print
IF +TIUPRINT'>0
Begin DoDot:2
+12 WRITE !!,"Item #",ORI,": ",!,$PIECE(TIUPRINT,U,2),!
+13 IF IO=IO(0)
IF '$DATA(ZTQUEUED)
IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:2
QUIT
+14 IF +$GET(TIUPFLG)
SET TIUFLAG=+$$CHARTONE^TIURA1(TIUDA)
+15 SET DFN=$PIECE($GET(^TIU(8925,+TIUDA,0)),U,2)
+16 IF +TIUTYP
Begin DoDot:2
+17 SET TIUPMTHD=$$PRNTMTHD^TIULG(+TIUTYP)
+18 SET TIUPGRP=$$PRNTGRP^TIULG(+TIUTYP)
+19 SET TIUPFHDR=$$PRNTHDR^TIULG(+TIUTYP)
+20 SET TIUPFNBR=$$PRNTNBR^TIULG(+TIUTYP)
End DoDot:2
+21 IF +$$ISADDNDM^TIULC1(TIUDA)
Begin DoDot:2
+22 SET TIUDA=+$PIECE($GET(^TIU(8925,TIUDA,0)),U,6)
+23 SET TIUDTYP=+$GET(^TIU(8925,TIUDA,0))
End DoDot:2
+24 IF +$GET(^TIU(8925,TIUDA,21))>0
Begin DoDot:2
+25 SET TIUDA=+$GET(^TIU(8925,TIUDA,21))
+26 SET TIUDTYP=+$GET(^TIU(8925,TIUDA,0))
End DoDot:2
+27 if +$DATA(ORINDX(TIUDA))
QUIT
+28 IF +$GET(TIUDTYP)>0
Begin DoDot:2
+29 SET TIUPMTHD=$$PRNTMTHD^TIULG(+TIUDTYP)
+30 SET TIUPGRP=$$PRNTGRP^TIULG(+TIUDTYP)
+31 SET TIUPFHDR=$$PRNTHDR^TIULG(+TIUDTYP)
+32 SET TIUPFNBR=$$PRNTNBR^TIULG(+TIUDTYP)
End DoDot:2
+33 IF $GET(TIUPMTHD)]""
IF +$GET(TIUPGRP)
IF ($GET(TIUPFHDR)]"")
IF ($GET(TIUPFNBR)]"")
SET ORY(TIUPMTHD,$GET(TIUPGRP)_"$"_TIUPFHDR_";"_DFN,ORI,TIUDA)=TIUPFNBR
+34 IF '$TEST
SET ORY(TIUPMTHD,DFN,ORI,TIUDA)=""
+35 SET ORINDX(TIUDA)=ORI
End DoDot:1
if $DATA(ORQUIT)!$DATA(DIROUT)
QUIT
+36 SET TIUPMTHD=""
FOR
SET TIUPMTHD=$ORDER(ORY(TIUPMTHD))
if TIUPMTHD=""
QUIT
Begin DoDot:1
+37 DO PRNTDOC^TIURA(TIUPMTHD,.ORY)
End DoDot:1
+38 QUIT
BROWSE ; -- browse document
+1 NEW ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG,TIUQUIT
SET VALMBCK=""
+2 IF '$GET(ORNMBR)
SET ORNMBR=$$ORDERS^ORCHART("browse")
if 'ORNMBR
QUIT
+3 FOR ORI=1:1:$LENGTH(ORNMBR,",")
SET NMBR=$PIECE(ORNMBR,",",ORI)
if NMBR
Begin DoDot:1
+4 SET IDX=$GET(^TMP("OR",$JOB,"CURRENT","IDX",NMBR))
+5 SET TIUDA=+IDX
if '+TIUDA
QUIT
+6 DO CLEAR^VALM1
DO BROWS1^TIURA("TIU BROWSE FOR CLINICIAN")
+7 SET VALMBCK="R"
if +$GET(TIUCHNG)
SET OREBUILD=1
+8 IF +$GET(TIUQUIT)
SET ORQUIT=1
End DoDot:1
if $DATA(ORQUIT)
QUIT
+9 QUIT
+10 ;
EX ; -- exit action
+1 if $GET(OREBUILD)
DO TAB^ORCHART(ORTAB,1)
+2 if $DATA(^TMP("OR",$JOB,"CURRENT","MENU"))
SET XQORM("HIJACK")=^("MENU")
+3 QUIT
GETTOT(ORY,DFN) ; --get total count of signed progress notes, not
+1 ; counting addendums and child interdisciplinary notes
+2 ; ^TIU(8925,"ACLPT",3) refers to progress notes class
+3 NEW ORTIDT,ORTIFN
+4 SET ORY=0
+5 if '$GET(DFN)
QUIT
+6 FOR ORTIDT=0:0
SET ORTIDT=$ORDER(^TIU(8925,"ACLPT",3,DFN,ORTIDT))
if ORTIDT<1
QUIT
Begin DoDot:1
+7 FOR ORTIFN=0:0
SET ORTIFN=$ORDER(^TIU(8925,"ACLPT",3,DFN,ORTIDT,ORTIFN))
if ORTIFN<1
QUIT
Begin DoDot:2
+8 SET ORY=ORY+1
+9 QUIT
End DoDot:2
End DoDot:1
+10 QUIT
