- 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 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=""
- +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