source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCNOTE.m

ORCNOTE ; SLC/MKB - Progress Note actions ;25-JAN-2001 16:18:00
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**22,48,65,104**;Dec 17, 1997
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...")
 . . 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