ORCNOTE.m

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 ---ORCNOTE   9551     printed  Mar 13, 2025@21:33:44                                                                                                                                                                                                     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=""