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

TIUROR.m

Go to the documentation of this file.
  1. TIUROR ;SLC/JER - New PATIENT Review screen ; 9/5/01
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**10,86,88,100,123,143**;Jun 20, 1997
  1. ; Split rtn into TIUROR & TIUROR1 11/27/00
  1. EN ; -- main entry point for TIU OE/RR REVIEW PN
  1. D EN^VALM("TIU OE/RR REVIEW PN")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. N TIUCTXT,TIUPNM,TIUSSN,TIULOC,TIUDOB,TIUHDR,TIUCWAD,TIUDCNT,VADM,VA
  1. N TIUDFN I +$D(@VALMAR@(0))'>0 S VALMQUIT=1 Q
  1. S TIUDFN=+$G(@VALMAR@("DFN"))
  1. S TIUCWAD=$$CWAD^GMRPNOR1(TIUDFN) S:TIUCWAD]"" TIUCWAD="<"_TIUCWAD_">"
  1. S TIUDCNT=$J($S($G(@VALMAR@("CTXT"))="INIT":"Last ",1:"")_+@VALMAR@(0)_" note(s)",16)
  1. S TIUCTXT=$$UP^XLFSTR($$PNAME^TIULC1(@VALMAR@("CLASS")))
  1. S TIUCTXT=$$TITLE^TIUU(TIUCTXT)
  1. S TIUHDR=$$SETSTR^VALM1(TIUCWAD,$G(TIUHDR),1,20)
  1. S TIUHDR=$$SETSTR^VALM1(TIUCTXT,$G(TIUHDR),27,28)
  1. S TIUHDR=$$SETSTR^VALM1(TIUDCNT,$G(TIUHDR),64,16)
  1. S VALMHDR(1)=TIUHDR,TIUHDR=""
  1. S TIUPNM=$$NAME^TIULO(TIUDFN),TIUSSN=$$SSN^TIULO(TIUDFN)
  1. S TIUDOB=$$DOB^TIULO(TIUDFN)_" ("_$$AGE^TIULO(TIUDFN)_")"
  1. S TIULOC=$G(^DPT(+TIUDFN,.1))
  1. S:TIULOC]"" TIULOC=TIULOC_"/"_$G(^DPT(+TIUDFN,.101))
  1. S TIUHDR=$$SETSTR^VALM1(TIUPNM,$G(TIUHDR),1,20)
  1. S TIUHDR=$$SETSTR^VALM1(TIUSSN,$G(TIUHDR),22,11)
  1. S TIUHDR=$$SETSTR^VALM1(TIULOC,$G(TIUHDR),35,20)
  1. S TIUHDR=$$SETSTR^VALM1(TIUDOB,$G(TIUHDR),64,16)
  1. S VALMHDR(2)=TIUHDR
  1. Q
  1. ;
  1. INIT(CLASS,CONTEXT,DFN,TIUOCC) ; -- init variables and list array
  1. N TIUR,TIUI,TIUY,TIUPICK,TIUQUIT,TIUCCTXT,TIUDUZ,TIUERLY,TIULATE
  1. N TIUPREF,TIUOCTXT,TIURCTXT,TIUSEQ,TIUDPRM
  1. N DUOUT,DTOUT,DIROUT ;1/8/01
  1. I $G(@VALMAR@("SEQ"))]"" S TIUSEQ=$G(@VALMAR@("SEQ"))
  1. I +$G(@VALMAR@("CTXT")) S TIURCTXT=$G(@VALMAR@("CTXT"))
  1. K @VALMAR,VALMCNT,^TMP("TIURIDX",$J)
  1. K ^TMP("TIUYARRAY",$J) ; TIU*1.0*143
  1. S TIUPREF=$$PERSPRF^TIULE(DUZ)
  1. S TIUSEQ=$G(TIUSEQ,$S($P(TIUPREF,U,4)="A":"A",1:"D"))
  1. S TIUPICK=+$O(^ORD(101,"B","TIU ACTION SELECT LIST ELEMENT",0))
  1. S DFN=$S(+$G(DFN):+$G(DFN),+$G(ORVP):+$G(ORVP),1:+$$PATIENT^TIULA)
  1. I $S($D(DUOUT):1,$D(DTOUT):1,$D(DIROUT):1,+$G(DFN)'>0:1,1:0) S VALMQUIT=1 Q
  1. I +$G(CONTEXT)'=9999,'+$G(TIUOCC) S TIUOCC=$S(+$P(TIUPREF,U,10):+$P(TIUPREF,U,10),1:100)
  1. S ^TMP("TIUR",$J,"RTN")="TIUROR"
  1. I '$O(^TIU(8925,"ACLPT",CLASS,DFN,0)),'$O(^TIU(8925,"ACLAU",CLASS,DUZ,DFN,0)),'$O(^TIU(8925,"ACLEC",CLASS,DUZ,DFN,0)) D Q:$G(CONTEXT)'=9999
  1. . N TIUST
  1. . S TIUST=$S(CONTEXT=2:"UNSIGNED ",CONTEXT=3:"UNCOSIGNED ",1:"SIGNED ")
  1. . S VALMCNT=2,^TMP("TIUR",$J,0)=0
  1. . S ^TMP("TIUR",$J,1,0)=""
  1. . S ^TMP("TIUR",$J,2,0)="No "_TIUST_$$UP^XLFSTR($$PNAME^TIULC1(CLASS))_" Available for "_$$PTNAME^TIULC1(DFN)
  1. . S TIUOCTXT=CONTEXT
  1. . I CONTEXT=4 S TIUOCTXT=TIUOCTXT_U_TIUDUZ
  1. . I CONTEXT=5 S TIUOCTXT=TIUOCTXT_U_+TIUERLY_U_+TIULATE
  1. . S ^TMP("TIUR",$J,"SEQ")=$G(TIUSEQ)
  1. . S ^TMP("TIUR",$J,"CLASS")=CLASS,^("DFN")=DFN,^("CTXT")=TIUOCTXT D HDR
  1. I $G(CONTEXT)=9999 S TIUCCTXT=1,TIUOCC=9999999
  1. ; -- Set vars needed for RBLD if user ^s:
  1. S ^TMP("TIUR",$J,"CLASS")=CLASS,^("DFN")=DFN,^("OCC")=TIUOCC,^("CTXT")=+$G(TIURCTXT)
  1. S CONTEXT=$S($G(CONTEXT)=9999:$$ASKCTXT^TIUROR1,+$G(CONTEXT):+$G(CONTEXT),1:1)
  1. ; -- 1=Signed 2=Unsigned 3=Uncosigned 4=Signed/Author 5=Signed/Date --
  1. I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) D RBLD Q
  1. I $S(CONTEXT=1:1,CONTEXT=2:1,CONTEXT=3:1,1:0) S TIUERLY="",TIULATE="",TIUDUZ=DUZ
  1. I CONTEXT=4 D Q:+$G(TIUQUIT)>0
  1. . S TIUERLY="",TIULATE=""
  1. . S TIUDUZ=$S(+$G(TIURCTXT)'=4:+$$AUTHOR^TIULA2(1),+$P(TIURCTXT,U,2)'>0:+$$AUTHOR^TIULA2(1),+$G(TIUCCTXT):+$$AUTHOR^TIULA2(1),1:+$P(TIURCTXT,U,2))
  1. . I $S($D(DUOUT):1,$D(DTOUT):1,$D(DIROUT):1,+$G(TIUDUZ)'>0:1,1:0) S TIUQUIT=1 D RBLD Q ; changed DIRUT to DTOUT. 10/20/00
  1. . S TIUSEQ=$S(+$G(TIUCCTXT):$P($$ASKSEQ^TIULA3(TIUSEQ),U),$G(TIUSEQ)']"":$P($$ASKSEQ^TIULA3(TIUSEQ),U),1:$G(TIUSEQ))
  1. . I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) S TIUQUIT=1 D RBLD
  1. I CONTEXT=5 D Q:+$G(TIUQUIT)>0
  1. . S TIUDUZ=+$G(DUZ)
  1. . S TIUERLY=$S(+$G(TIURCTXT)'=5:$$EDATE^TIULA("",7,""),+$P(TIURCTXT,U,2)'>0:$$EDATE^TIULA("",7,""),+$G(TIUCCTXT):$$EDATE^TIULA("",7,""),1:+$P(TIURCTXT,U,2))
  1. . I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) S TIUQUIT=1 D RBLD Q
  1. . S TIUERLY=$P(TIUERLY,U)
  1. . S TIULATE=$S(+$G(TIURCTXT)'=5:$$LDATE^TIULA("",7,""),+$P(TIURCTXT,U,3)'>0:$$LDATE^TIULA("",7,""),+$G(TIUCCTXT):$$LDATE^TIULA("",7,""),1:+$P(TIURCTXT,U,3))
  1. . I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) S TIUQUIT=1 D RBLD Q
  1. . S TIULATE=$P(TIULATE,U)
  1. . I TIUERLY>TIULATE D SWAP^TIUR(.TIUERLY,.TIULATE)
  1. . I $L(TIULATE,".")=1 D EXPRANGE^TIUR(.TIUERLY,.TIULATE)
  1. . S TIUSEQ=$S(+$G(TIUCCTXT):$P($$ASKSEQ^TIULA3(TIUSEQ),U),$G(TIUSEQ)']"":$P($$ASKSEQ^TIULA3(TIUSEQ),U),1:$G(TIUSEQ))
  1. . I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) S TIUQUIT=1 D RBLD
  1. I '$G(TIURBLD) W !,"Searching for the progress notes"
  1. N TIUEXPKD
  1. D CONTEXT^TIUSRVLL(.TIUY,CLASS,CONTEXT,DFN,TIUERLY,TIULATE,TIUDUZ,TIUOCC,TIUSEQ,.TIUEXPKD) W "."
  1. ; I $D(TIUY)'>9 D Q ; original code
  1. I $D(^TMP("TIUYARRAY",$J))'>9 D Q ; TIU*1.0*143
  1. . N TIUST
  1. . S TIUST=$S(CONTEXT=2:"UNSIGNED ",CONTEXT=3:"UNCOSIGNED ",1:"SIGNED ")
  1. . S VALMCNT=2,^TMP("TIUR",$J,0)=0
  1. . S ^TMP("TIUR",$J,1,0)=""
  1. . S ^TMP("TIUR",$J,2,0)="No "_TIUST_$$UP^XLFSTR($$PNAME^TIULC1(CLASS))_" Available for "_$$PTNAME^TIULC1(DFN)
  1. . S ^TMP("TIUR",$J,"CLASS")=CLASS,^("DFN")=DFN
  1. . S TIUOCTXT=CONTEXT
  1. . I CONTEXT=4 S TIUOCTXT=TIUOCTXT_U_TIUDUZ
  1. . I CONTEXT=5 S TIUOCTXT=TIUOCTXT_U_+TIUERLY_U_+TIULATE
  1. . S ^TMP("TIUR",$J,"SEQ")=$G(TIUSEQ)
  1. . S ^TMP("TIUR",$J,"CTXT")=$S('+$G(TIUCCTXT):"INIT",1:TIUOCTXT) D HDR
  1. S TIUI=""
  1. ; F S TIUI=$O(TIUY(TIUI)) Q:TIUI="" D ; original code
  1. F S TIUI=$O(^TMP("TIUYARRAY",$J,TIUI)) Q:TIUI="" D ; TIU*1.0*143
  1. . N AUT,RDT,STAT,TITL,TIUD0,TIUD12,TIUD13,PREFIX
  1. . N TIUGDATA
  1. . S TIUD0=$G(^TIU(8925,+^TMP("TIUYARRAY",$J,TIUI),0)),TIUD12=$G(^(12)),TIUD13=$G(^(13)) ; **
  1. . ; S TIUD0=$G(^TIU(8925,+TIUY(TIUI),0)),TIUD12=$G(^(12)),TIUD13=$G(^(13)) ; original
  1. . S VALMCNT=+$G(VALMCNT)+1 W:(VALMCNT#100'>0) "."
  1. . S TITL=$$PNAME^TIULC1(+TIUD0)
  1. . I TITL="Addendum" S TITL=TITL_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUD0,U,6),0)))
  1. . ; -- Mark ID note '<' and/or has addendum '+',
  1. . S PREFIX=$$PREFIX^TIULA2(+^TMP("TIUYARRAY",$J,TIUI),0) ; TIU*1.0*143
  1. . ; S PREFIX=$$PREFIX^TIULA2(+TIUY(TIUI),0) ; original
  1. . S TITL=PREFIX_TITL
  1. . S AUT=$$NAME^TIULS($$PERSNAME^TIULC1(+$P(TIUD12,U,2)),"LAST,FI")
  1. . S RDT=$$DATE^TIULS(+TIUD13,"MM/DD/YY HR:MIN")
  1. . S STAT=$$LOW^XLFSTR($P($G(^TIU(8925.6,+$P(TIUD0,U,5),0)),U))
  1. . S TIUR=$$SETFLD^VALM1(VALMCNT,$G(TIUR),"NUMBER")
  1. . S TIUR=$$SETFLD^VALM1(TITL,$G(TIUR),"TITLE")
  1. . S TIUR=$$SETFLD^VALM1(AUT,$G(TIUR),"AUTHOR")
  1. . S TIUR=$$SETFLD^VALM1(RDT,$G(TIUR),"REF DATE")
  1. . S TIUR=$$SETFLD^VALM1(STAT,$G(TIUR),"STATUS")
  1. . S ^TMP("TIUR",$J,VALMCNT,0)=TIUR
  1. . S ^TMP("TIUR",$J,0)=VALMCNT
  1. . S ^TMP("TIURIDX",$J,VALMCNT)=VALMCNT_U_+^TMP("TIUYARRAY",$J,TIUI)_U_PREFIX ; TIU*1.0*143
  1. . ; S ^TMP("TIURIDX",$J,VALMCNT)=VALMCNT_U_+TIUY(TIUI)_U_PREFIX ; original
  1. . S ^TMP("TIUR",$J,"IEN",+^TMP("TIUYARRAY",$J,TIUI),VALMCNT)="" ; TIU*1.0*143
  1. . ; S ^TMP("TIUR",$J,"IEN",+TIUY(TIUI),VALMCNT)="" ;original
  1. . S ^TMP("TIUR",$J,"IDX",VALMCNT,VALMCNT)=""
  1. . ; TIUGDATA = 0 or DA^haskid^IDparent^prmsort:
  1. . S TIUGDATA=$$IDDATA^TIURECL1(+^TMP("TIUYARRAY",$J,TIUI),TIUD0) ; TIU*1.0*143
  1. . ; S TIUGDATA=$$IDDATA^TIURECL1(+TIUY(TIUI),TIUD0) ; original
  1. . I $G(TIUGDATA) S ^TMP("TIUR",$J,"IDDATA",+^TMP("TIUYARRAY",$J,TIUI))=TIUGDATA ; TIU*1.0*143
  1. . ; I $G(TIUGDATA) S ^TMP("TIUR",$J,"IDDATA",+TIUY(TIUI))=TIUGDATA ; original
  1. S ^TMP("TIUR",$J,"#")=TIUPICK_"^1:"_+VALMCNT
  1. S ^TMP("TIUR",$J,"CLASS")=CLASS
  1. S ^TMP("TIUR",$J,"DFN")=DFN
  1. S ^TMP("TIUR",$J,"OCC")=+$G(TIUOCC)
  1. S TIUOCTXT=CONTEXT
  1. I CONTEXT=4 S TIUOCTXT=TIUOCTXT_U_TIUDUZ
  1. I CONTEXT=5 S TIUOCTXT=TIUOCTXT_U_+TIUERLY_U_+TIULATE
  1. S ^TMP("TIUR",$J,"SEQ")=$G(TIUSEQ)
  1. S ^TMP("TIUR",$J,"CTXT")=$S('+$G(TIUCCTXT)&(VALMCNT'<TIUOCC):"INIT",1:TIUOCTXT)
  1. I CONTEXT=1,(+$G(TIUOCC)=9999999) D SAVE^TIUROR1
  1. I +$G(TIUCCTXT),$D(^TMP("TIUR",$J,0)) D HDR
  1. ; If first build (not rebuild), expand parents to show kids that
  1. ;meet criteria:
  1. I '$G(TIURBLD),$D(TIUEXPKD) D
  1. . D EXPANDKD^TIUR2(.TIUEXPKD,"",CONTEXT)
  1. ; K ^TMP("TIUYARRAY",$J) ; TIU*1.0*143
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. D CLEAN^VALM10
  1. K DFN,VALMY,VALMCNT,VALMKEY,^TMP("TIURSAVE",$J)
  1. K ^TMP("TIURIDX",$J)
  1. K TIUGLINK ;**100**
  1. Q
  1. ;
  1. RBLD ; -- rebuild list after actions
  1. N TIUEXP,TIURBLD
  1. S TIURBLD=1
  1. I +$O(^TMP("TIUR",$J,"EXPAND",0)) D G RBLDX
  1. . M TIUEXP=^TMP("TIUR",$J,"EXPAND")
  1. . D INIT(+$G(^TMP("TIUR",$J,"CLASS")),+$G(^("CTXT")),+$G(^("DFN")),+$G(^("OCC")))
  1. . D RELOAD^TIUROR1(.TIUEXP)
  1. . D BREATHE^TIUROR1(1)
  1. D INIT(+$G(^TMP("TIUR",$J,"CLASS")),+$G(^("CTXT")),+$G(^("DFN")),+$G(^("OCC")))
  1. ;D HDR S VALMBCK="R",VALMBG=1,VALMCNT=+$G(^TMP("TIUR",$J,0))
  1. D HDR S VALMBCK="R",VALMCNT=+$G(^TMP("TIUR",$J,0))
  1. RBLDX I $G(VALMBG)>$G(VALMCNT) S VALMBG=$G(VALMCNT)
  1. Q