Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORCNOTE

ORCNOTE.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; External Reference
  1. ; #2937 ^TUI(8925
  1. ; #10089 ^%ZISC
  1. ; #3002 $$DEVICE^TIUDEV, QUE^TIUDEV
  1. ; #3001 $$ASKSIG^TIULA1
  1. ; #2323 $$ISADDNDM^TIULC1, $$PNAME^TIULC1, $$PTNAME^TIULC1
  1. ; #2863 SETPARM^TIULE
  1. ; #4426 $$EMPTYDOC^TIULF
  1. ; #3003 $$PRNTGRP^TIULG, $$PRNTHDR^TIULG,
  1. ; $$PRNTMTHD^TIULG, $$PRNTNBR^TIULG
  1. ; #3000 FIXLST^TIULM
  1. ; #2322 $$CANDO^TIULP, $$REQCOSIG^TIULP
  1. ; #2999 $$FLAG^TIUPRPN3
  1. ; #2998 BROWS1^TIURA, EDIT1^TIURA, PRNTDOC^TIURA
  1. ; #2694 $$CHARTONE^TIURA1, ADDEND1^TIURA1, SIGNER^TIURA1
  1. ; #2997 DEL^TIURB
  1. ; #2996 COPY1^TIURC
  1. ; #2995 $$ASKCSNR^TIURS, EDSIG^TIURS, ES^TIURS
  1. ; #3441 $$HASDAD^TIUSRVLI
  1. ; #2994 $$READ^TIUU
  1. ; #10118 EN^VALM
  1. ; #10116 CLEAR^VALM1, FULL^VALM1
  1. ;
  1. ELSIG ; Sign rec
  1. N ASK,TIUEVNT,TIUDA,TIUES,TIUI,X,X1,Y,ORI,NMBR,ORPICK,ORQUIT,IDX,TIUPOP,TIUPRM0,TIUPRM1
  1. I '$D(TIUPRM0) D SETPARM^TIULE
  1. I $P(TIUPRM0,U,2)'>0 W !,"Electronic signature not yet enabled." H 3 G ELSIGX
  1. S ORPICK="",VALMBCK=""
  1. I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("sign") Q:'ORNMBR
  1. I +ORNMBR D FULL^VALM1
  1. S ORI=1
  1. F S NMBR=$P(ORNMBR,",",ORI) Q:+NMBR'>0!$D(ORQUIT) D
  1. . N TIU0,TIU12,TIU15,TIUSTAT,TIUEVNT,TIUTYPE,TIUDA
  1. . S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR)),ORI=+$G(ORI)+1
  1. . S TIUDA=+IDX,TIU0=$G(^TIU(8925,+TIUDA,0)),TIU12=$G(^(12)),TIU15=$G(^(15))
  1. . S TIUSTAT=+$P(TIU0,U,5)
  1. . S TIUTYPE=$$PNAME^TIULC1(+$G(^TIU(8925,+TIUDA,0)))
  1. . S TIUEVNT=$S(+TIUSTAT'>5:"SIGNATURE",1:"COSIGNATURE")
  1. . S ASK=$$CANDO^TIULP(TIUDA,TIUEVNT)
  1. . I +ASK>0 D
  1. . . L +^TIU(8925,+TIUDA):1
  1. . . E S ASK="0^ Another user is editing this entry."
  1. . I +ASK'>0,$P(ASK,U,2)]"" D I 1
  1. . . D FULL^VALM1
  1. . . W !!,"Item #: ",NMBR,!,$P(ASK,U,2),!
  1. . . W !,"Removed from signature list.",!
  1. . . I $$READ^TIUU("FOA","Press RETURN to continue...")
  1. . E D
  1. . . I $S(+$$REQCOSIG^TIULP(+TIU0,+TIUDA,DUZ):1,+$P(TIU15,U,6):1,1:0),(+$P(TIU12,U,8)'>0) D Q:+$G(TIUPOP)
  1. . . . N COSIGNER
  1. . . . W !!,"Item #",NMBR,": ",TIUTYPE," for "
  1. . . . W $$PTNAME^TIULC1($P(TIU0,U,2))," will need cosignature..."
  1. . . . S COSIGNER=$$ASKCSNR^TIURS(TIUDA,DUZ)
  1. . . . I +COSIGNER'>0 D
  1. . . . . S TIUPOP=1
  1. . . . . W !!,"Item #",NMBR,": MUST have a cosigner, before you may sign."
  1. . . . . W !!,"Removed from signature list.",!
  1. . . . . I $$READ^TIUU("FOA","Press RETURN to continue...")
  1. . . ; OR*3.0*370 DJH Do not allow notes without any text to be signed
  1. . . I $$EMPTYDOC^TIULF(+TIUDA) D Q
  1. . . . W !!,"Item #",NMBR,": This note contains no text and cannot be signed."
  1. . . . W !!,"Removed from signature list.",!
  1. . . . I $$READ^TIUU("FOA","Press RETURN to continue...")
  1. . . N TIU,TIUY
  1. . . D EN^VALM("ORC TIU SIGN/COSIGN")
  1. I +$G(ORPICK)'>0 D G ELSIGX
  1. . S VALMSG="** Signature List Empty...Nothing signed. **"
  1. I +$G(ORPICK)>0 D
  1. . S TIUES=$$ASKSIG^TIULA1
  1. . I '+TIUES S VALMSG="** Nothing Signed. **" Q
  1. . F ORI=1:1:$L(ORPICK,",") S NMBR=$P(ORPICK,",",ORI) D:NMBR Q:$D(ORQUIT)
  1. . . S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR)),TIUDA=+IDX
  1. . . D ES^TIURS(TIUDA,TIUES,NMBR)
  1. I $G(ORPICK)']"" S VALMSG="** Nothing Signed. **"
  1. E S VALMSG="** Item"_$S($L(ORPICK,",")>1:"s ",1:" ")_ORPICK_" Signed. **"
  1. ELSIGX K VALMY S VALMBCK="R"
  1. Q
  1. ACCEPT(ORPICK,NMBR) ; Adds item(s) to signature list
  1. D FULL^VALM1
  1. S ORPICK=$G(ORPICK)_$S($L(ORPICK):",",1:"")_NMBR,OREBUILD=1
  1. W !,"Item #",NMBR," added to the signature list." H 3
  1. Q
  1. SIGN ; -- sign notes
  1. N ORI,NMBR,ORQUIT,IDX,TIUDA S VALMBCK=""
  1. I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("sign") Q:'ORNMBR
  1. F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
  1. . S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
  1. . S TIUDA=+IDX Q:'+TIUDA
  1. . D EDSIG^TIURS(TIUDA,"",1)
  1. Q
  1. ;
  1. ADDENDUM ; -- make addendum
  1. N ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG S VALMBCK=""
  1. I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("") Q:'ORNMBR
  1. F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
  1. . S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
  1. . S TIUDA=+IDX Q:'+TIUDA
  1. . I +$$ISADDNDM^TIULC1(TIUDA) D Q
  1. . . W !,$C(7),"You may not make addenda to addenda."
  1. . . I $$READ^TIUU("EA","Press RETURN to continue...") W ""
  1. . D CLEAR^VALM1,ADDEND1^TIURA1 I +$G(TIUCHNG) S OREBUILD=1
  1. . I '+$G(TIUCHNG) S VALMBCK="R"
  1. Q
  1. ;
  1. EDIT ; -- edit notes
  1. N ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG S VALMBCK=""
  1. I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("edit") Q:'ORNMBR
  1. F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
  1. . S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
  1. . S TIUDA=+IDX Q:'+TIUDA
  1. . D CLEAR^VALM1,EDIT1^TIURA I +$G(TIUCHNG) S OREBUILD=1
  1. S VALMBCK="R"
  1. Q
  1. COPY ; -- copy notes
  1. N ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG,ORTAB S VALMBCK=""
  1. I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("copy") Q:'ORNMBR
  1. F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
  1. . S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
  1. . S TIUDA=+IDX Q:'+TIUDA
  1. . D COPY1^TIURC I +$G(TIUCHNG) S OREBUILD=1
  1. . I '+$G(TIUCHNG) S VALMBCK="R"
  1. Q
  1. DELETE ; -- delete notes
  1. N ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG S VALMBCK=""
  1. I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("delete") Q:'ORNMBR
  1. F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
  1. . S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
  1. . S TIUDA=+IDX Q:'+TIUDA
  1. . D DEL^TIURB(TIUDA) I +$G(TIUCHNG) S OREBUILD=1
  1. Q
  1. SIGNERS ; -- Identify additional signers
  1. N ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG S VALMBCK=""
  1. I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("") Q:'ORNMBR
  1. F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
  1. . S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
  1. . S TIUDA=+IDX Q:'+TIUDA
  1. . D FULL^VALM1,SIGNER^TIURA1
  1. S VALMBCK="R"
  1. Q
  1. PRINT ; Print selected documents
  1. N DFN,TIUDA,TIUDPRM,TIUDARR,TIUDATA,TIUI,DIROUT,TIUDE,POP,TIUPFLG
  1. N TIUSPG,TIUDEV
  1. S VALMBCK="" I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("print") Q:'ORNMBR
  1. D CLEAR^VALM1
  1. I +$$CHARTANY(ORNMBR) S TIUPFLG=$$FLAG^TIUPRPN3
  1. S TIUSPG=1
  1. S TIUDEV=$$DEVICE^TIUDEV(.IO) ; Get Device/allow queueing
  1. I $S(IO']"":1,TIUDEV']"":1,1:0) G PRINTX
  1. I $D(IO("Q")) D QUE^TIUDEV("PRINTN^ORCNOTE",TIUDEV) G PRINTX
  1. D PRINTN
  1. PRINTX N IOSTBM D ^%ZISC,FIXLST^TIULM
  1. K VALMY S VALMBCK="R"
  1. Q
  1. CHARTANY(ORNMBR) ; Evaluate selected documents for chart print
  1. N ORI,NMBR,ORSLT S ORSLT=0
  1. F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) Q:+NMBR'>0!+ORSLT D
  1. . N IDX,TIUDA
  1. . S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
  1. . S TIUDA=+IDX Q:'TIUDA
  1. . S ORSLT=+$$CHARTONE^TIURA1(TIUDA)
  1. Q ORSLT
  1. PRINTN ; Loop through selected doc's & invoke print code as appropriate
  1. N TIUI,TIUTYP,ORINDX,ORY,DFN K ^TMP("TIUPR",$J)
  1. N ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG
  1. U IO
  1. F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)!$D(DIROUT)
  1. . N TIUPMTHD,TIUTYP,TIUPFHDR,TIUPFNBR,TIUPGRP,TIUPRINT,TIUDTYP,TIUFLAG
  1. . S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
  1. . S TIUDA=+IDX Q:'+TIUDA Q:'$D(^TIU(8925,TIUDA,0))
  1. . S TIUTYP=$P($G(^TIU(8925,TIUDA,0)),U)
  1. . ; Evaluate whether user can print record
  1. . S TIUPRINT=$$CANDO^TIULP(TIUDA,"PRINT RECORD")
  1. . I +TIUPRINT'>0 D Q ; Exclude records user can't print
  1. . . W !!,"Item #",ORI,": ",!,$P(TIUPRINT,U,2),!
  1. . . I IO=IO(0),'$D(ZTQUEUED),$$READ^TIUU("EA","RETURN to continue...")
  1. . I +$G(TIUPFLG) S TIUFLAG=+$$CHARTONE^TIURA1(TIUDA)
  1. . S DFN=$P($G(^TIU(8925,+TIUDA,0)),U,2)
  1. . I +TIUTYP D
  1. . . S TIUPMTHD=$$PRNTMTHD^TIULG(+TIUTYP)
  1. . . S TIUPGRP=$$PRNTGRP^TIULG(+TIUTYP)
  1. . . S TIUPFHDR=$$PRNTHDR^TIULG(+TIUTYP)
  1. . . S TIUPFNBR=$$PRNTNBR^TIULG(+TIUTYP)
  1. . I +$$ISADDNDM^TIULC1(TIUDA) D
  1. . . S TIUDA=+$P($G(^TIU(8925,TIUDA,0)),U,6)
  1. . . S TIUDTYP=+$G(^TIU(8925,TIUDA,0))
  1. . I +$G(^TIU(8925,TIUDA,21))>0 D
  1. . . S TIUDA=+$G(^TIU(8925,TIUDA,21))
  1. . . S TIUDTYP=+$G(^TIU(8925,TIUDA,0))
  1. . Q:+$D(ORINDX(TIUDA))
  1. . I +$G(TIUDTYP)>0 D
  1. . . S TIUPMTHD=$$PRNTMTHD^TIULG(+TIUDTYP)
  1. . . S TIUPGRP=$$PRNTGRP^TIULG(+TIUDTYP)
  1. . . S TIUPFHDR=$$PRNTHDR^TIULG(+TIUDTYP)
  1. . . S TIUPFNBR=$$PRNTNBR^TIULG(+TIUDTYP)
  1. . I $G(TIUPMTHD)]"",+$G(TIUPGRP),($G(TIUPFHDR)]""),($G(TIUPFNBR)]"") S ORY(TIUPMTHD,$G(TIUPGRP)_"$"_TIUPFHDR_";"_DFN,ORI,TIUDA)=TIUPFNBR
  1. . E S ORY(TIUPMTHD,DFN,ORI,TIUDA)=""
  1. . S ORINDX(TIUDA)=ORI
  1. S TIUPMTHD="" F S TIUPMTHD=$O(ORY(TIUPMTHD)) Q:TIUPMTHD="" D
  1. . D PRNTDOC^TIURA(TIUPMTHD,.ORY)
  1. Q
  1. BROWSE ; -- browse document
  1. N ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG,TIUQUIT S VALMBCK=""
  1. I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("browse") Q:'ORNMBR
  1. F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
  1. . S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
  1. . S TIUDA=+IDX Q:'+TIUDA
  1. . D CLEAR^VALM1,BROWS1^TIURA("TIU BROWSE FOR CLINICIAN")
  1. . S VALMBCK="R" S:+$G(TIUCHNG) OREBUILD=1
  1. . I +$G(TIUQUIT) S ORQUIT=1
  1. Q
  1. ;
  1. EX ; -- exit action
  1. D:$G(OREBUILD) TAB^ORCHART(ORTAB,1)
  1. S:$D(^TMP("OR",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
  1. Q
  1. GETTOT(ORY,DFN) ; --get total count of signed progress notes, not
  1. ; counting addendums and child interdisciplinary notes
  1. ; ^TIU(8925,"ACLPT",3) refers to progress notes class
  1. N ORTIDT,ORTIFN
  1. S ORY=0
  1. Q:'$G(DFN)
  1. F ORTIDT=0:0 S ORTIDT=$O(^TIU(8925,"ACLPT",3,DFN,ORTIDT)) Q:ORTIDT<1 D
  1. .F ORTIFN=0:0 S ORTIFN=$O(^TIU(8925,"ACLPT",3,DFN,ORTIDT,ORTIFN)) Q:ORTIFN<1 D
  1. ..S ORY=ORY+1
  1. ..Q
  1. Q