- TIUROR ;SLC/JER - New PATIENT Review screen ; 9/5/01
- ;;1.0;TEXT INTEGRATION UTILITIES;**10,86,88,100,123,143**;Jun 20, 1997
- ; Split rtn into TIUROR & TIUROR1 11/27/00
- EN ; -- main entry point for TIU OE/RR REVIEW PN
- D EN^VALM("TIU OE/RR REVIEW PN")
- Q
- ;
- HDR ; -- header code
- N TIUCTXT,TIUPNM,TIUSSN,TIULOC,TIUDOB,TIUHDR,TIUCWAD,TIUDCNT,VADM,VA
- N TIUDFN I +$D(@VALMAR@(0))'>0 S VALMQUIT=1 Q
- S TIUDFN=+$G(@VALMAR@("DFN"))
- S TIUCWAD=$$CWAD^GMRPNOR1(TIUDFN) S:TIUCWAD]"" TIUCWAD="<"_TIUCWAD_">"
- S TIUDCNT=$J($S($G(@VALMAR@("CTXT"))="INIT":"Last ",1:"")_+@VALMAR@(0)_" note(s)",16)
- S TIUCTXT=$$UP^XLFSTR($$PNAME^TIULC1(@VALMAR@("CLASS")))
- S TIUCTXT=$$TITLE^TIUU(TIUCTXT)
- S TIUHDR=$$SETSTR^VALM1(TIUCWAD,$G(TIUHDR),1,20)
- S TIUHDR=$$SETSTR^VALM1(TIUCTXT,$G(TIUHDR),27,28)
- S TIUHDR=$$SETSTR^VALM1(TIUDCNT,$G(TIUHDR),64,16)
- S VALMHDR(1)=TIUHDR,TIUHDR=""
- S TIUPNM=$$NAME^TIULO(TIUDFN),TIUSSN=$$SSN^TIULO(TIUDFN)
- S TIUDOB=$$DOB^TIULO(TIUDFN)_" ("_$$AGE^TIULO(TIUDFN)_")"
- S TIULOC=$G(^DPT(+TIUDFN,.1))
- S:TIULOC]"" TIULOC=TIULOC_"/"_$G(^DPT(+TIUDFN,.101))
- S TIUHDR=$$SETSTR^VALM1(TIUPNM,$G(TIUHDR),1,20)
- S TIUHDR=$$SETSTR^VALM1(TIUSSN,$G(TIUHDR),22,11)
- S TIUHDR=$$SETSTR^VALM1(TIULOC,$G(TIUHDR),35,20)
- S TIUHDR=$$SETSTR^VALM1(TIUDOB,$G(TIUHDR),64,16)
- S VALMHDR(2)=TIUHDR
- Q
- ;
- INIT(CLASS,CONTEXT,DFN,TIUOCC) ; -- init variables and list array
- N TIUR,TIUI,TIUY,TIUPICK,TIUQUIT,TIUCCTXT,TIUDUZ,TIUERLY,TIULATE
- N TIUPREF,TIUOCTXT,TIURCTXT,TIUSEQ,TIUDPRM
- N DUOUT,DTOUT,DIROUT ;1/8/01
- I $G(@VALMAR@("SEQ"))]"" S TIUSEQ=$G(@VALMAR@("SEQ"))
- I +$G(@VALMAR@("CTXT")) S TIURCTXT=$G(@VALMAR@("CTXT"))
- K @VALMAR,VALMCNT,^TMP("TIURIDX",$J)
- K ^TMP("TIUYARRAY",$J) ; TIU*1.0*143
- S TIUPREF=$$PERSPRF^TIULE(DUZ)
- S TIUSEQ=$G(TIUSEQ,$S($P(TIUPREF,U,4)="A":"A",1:"D"))
- S TIUPICK=+$O(^ORD(101,"B","TIU ACTION SELECT LIST ELEMENT",0))
- S DFN=$S(+$G(DFN):+$G(DFN),+$G(ORVP):+$G(ORVP),1:+$$PATIENT^TIULA)
- I $S($D(DUOUT):1,$D(DTOUT):1,$D(DIROUT):1,+$G(DFN)'>0:1,1:0) S VALMQUIT=1 Q
- I +$G(CONTEXT)'=9999,'+$G(TIUOCC) S TIUOCC=$S(+$P(TIUPREF,U,10):+$P(TIUPREF,U,10),1:100)
- S ^TMP("TIUR",$J,"RTN")="TIUROR"
- 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
- . N TIUST
- . S TIUST=$S(CONTEXT=2:"UNSIGNED ",CONTEXT=3:"UNCOSIGNED ",1:"SIGNED ")
- . S VALMCNT=2,^TMP("TIUR",$J,0)=0
- . S ^TMP("TIUR",$J,1,0)=""
- . S ^TMP("TIUR",$J,2,0)="No "_TIUST_$$UP^XLFSTR($$PNAME^TIULC1(CLASS))_" Available for "_$$PTNAME^TIULC1(DFN)
- . S TIUOCTXT=CONTEXT
- . I CONTEXT=4 S TIUOCTXT=TIUOCTXT_U_TIUDUZ
- . I CONTEXT=5 S TIUOCTXT=TIUOCTXT_U_+TIUERLY_U_+TIULATE
- . S ^TMP("TIUR",$J,"SEQ")=$G(TIUSEQ)
- . S ^TMP("TIUR",$J,"CLASS")=CLASS,^("DFN")=DFN,^("CTXT")=TIUOCTXT D HDR
- I $G(CONTEXT)=9999 S TIUCCTXT=1,TIUOCC=9999999
- ; -- Set vars needed for RBLD if user ^s:
- S ^TMP("TIUR",$J,"CLASS")=CLASS,^("DFN")=DFN,^("OCC")=TIUOCC,^("CTXT")=+$G(TIURCTXT)
- S CONTEXT=$S($G(CONTEXT)=9999:$$ASKCTXT^TIUROR1,+$G(CONTEXT):+$G(CONTEXT),1:1)
- ; -- 1=Signed 2=Unsigned 3=Uncosigned 4=Signed/Author 5=Signed/Date --
- I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) D RBLD Q
- I $S(CONTEXT=1:1,CONTEXT=2:1,CONTEXT=3:1,1:0) S TIUERLY="",TIULATE="",TIUDUZ=DUZ
- I CONTEXT=4 D Q:+$G(TIUQUIT)>0
- . S TIUERLY="",TIULATE=""
- . 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))
- . 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
- . S TIUSEQ=$S(+$G(TIUCCTXT):$P($$ASKSEQ^TIULA3(TIUSEQ),U),$G(TIUSEQ)']"":$P($$ASKSEQ^TIULA3(TIUSEQ),U),1:$G(TIUSEQ))
- . I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) S TIUQUIT=1 D RBLD
- I CONTEXT=5 D Q:+$G(TIUQUIT)>0
- . S TIUDUZ=+$G(DUZ)
- . 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))
- . I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) S TIUQUIT=1 D RBLD Q
- . S TIUERLY=$P(TIUERLY,U)
- . 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))
- . I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) S TIUQUIT=1 D RBLD Q
- . S TIULATE=$P(TIULATE,U)
- . I TIUERLY>TIULATE D SWAP^TIUR(.TIUERLY,.TIULATE)
- . I $L(TIULATE,".")=1 D EXPRANGE^TIUR(.TIUERLY,.TIULATE)
- . S TIUSEQ=$S(+$G(TIUCCTXT):$P($$ASKSEQ^TIULA3(TIUSEQ),U),$G(TIUSEQ)']"":$P($$ASKSEQ^TIULA3(TIUSEQ),U),1:$G(TIUSEQ))
- . I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) S TIUQUIT=1 D RBLD
- I '$G(TIURBLD) W !,"Searching for the progress notes"
- N TIUEXPKD
- D CONTEXT^TIUSRVLL(.TIUY,CLASS,CONTEXT,DFN,TIUERLY,TIULATE,TIUDUZ,TIUOCC,TIUSEQ,.TIUEXPKD) W "."
- ; I $D(TIUY)'>9 D Q ; original code
- I $D(^TMP("TIUYARRAY",$J))'>9 D Q ; TIU*1.0*143
- . N TIUST
- . S TIUST=$S(CONTEXT=2:"UNSIGNED ",CONTEXT=3:"UNCOSIGNED ",1:"SIGNED ")
- . S VALMCNT=2,^TMP("TIUR",$J,0)=0
- . S ^TMP("TIUR",$J,1,0)=""
- . S ^TMP("TIUR",$J,2,0)="No "_TIUST_$$UP^XLFSTR($$PNAME^TIULC1(CLASS))_" Available for "_$$PTNAME^TIULC1(DFN)
- . S ^TMP("TIUR",$J,"CLASS")=CLASS,^("DFN")=DFN
- . S TIUOCTXT=CONTEXT
- . I CONTEXT=4 S TIUOCTXT=TIUOCTXT_U_TIUDUZ
- . I CONTEXT=5 S TIUOCTXT=TIUOCTXT_U_+TIUERLY_U_+TIULATE
- . S ^TMP("TIUR",$J,"SEQ")=$G(TIUSEQ)
- . S ^TMP("TIUR",$J,"CTXT")=$S('+$G(TIUCCTXT):"INIT",1:TIUOCTXT) D HDR
- S TIUI=""
- ; F S TIUI=$O(TIUY(TIUI)) Q:TIUI="" D ; original code
- F S TIUI=$O(^TMP("TIUYARRAY",$J,TIUI)) Q:TIUI="" D ; TIU*1.0*143
- . N AUT,RDT,STAT,TITL,TIUD0,TIUD12,TIUD13,PREFIX
- . N TIUGDATA
- . S TIUD0=$G(^TIU(8925,+^TMP("TIUYARRAY",$J,TIUI),0)),TIUD12=$G(^(12)),TIUD13=$G(^(13)) ; **
- . ; S TIUD0=$G(^TIU(8925,+TIUY(TIUI),0)),TIUD12=$G(^(12)),TIUD13=$G(^(13)) ; original
- . S VALMCNT=+$G(VALMCNT)+1 W:(VALMCNT#100'>0) "."
- . S TITL=$$PNAME^TIULC1(+TIUD0)
- . I TITL="Addendum" S TITL=TITL_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUD0,U,6),0)))
- . ; -- Mark ID note '<' and/or has addendum '+',
- . S PREFIX=$$PREFIX^TIULA2(+^TMP("TIUYARRAY",$J,TIUI),0) ; TIU*1.0*143
- . ; S PREFIX=$$PREFIX^TIULA2(+TIUY(TIUI),0) ; original
- . S TITL=PREFIX_TITL
- . S AUT=$$NAME^TIULS($$PERSNAME^TIULC1(+$P(TIUD12,U,2)),"LAST,FI")
- . S RDT=$$DATE^TIULS(+TIUD13,"MM/DD/YY HR:MIN")
- . S STAT=$$LOW^XLFSTR($P($G(^TIU(8925.6,+$P(TIUD0,U,5),0)),U))
- . S TIUR=$$SETFLD^VALM1(VALMCNT,$G(TIUR),"NUMBER")
- . S TIUR=$$SETFLD^VALM1(TITL,$G(TIUR),"TITLE")
- . S TIUR=$$SETFLD^VALM1(AUT,$G(TIUR),"AUTHOR")
- . S TIUR=$$SETFLD^VALM1(RDT,$G(TIUR),"REF DATE")
- . S TIUR=$$SETFLD^VALM1(STAT,$G(TIUR),"STATUS")
- . S ^TMP("TIUR",$J,VALMCNT,0)=TIUR
- . S ^TMP("TIUR",$J,0)=VALMCNT
- . S ^TMP("TIURIDX",$J,VALMCNT)=VALMCNT_U_+^TMP("TIUYARRAY",$J,TIUI)_U_PREFIX ; TIU*1.0*143
- . ; S ^TMP("TIURIDX",$J,VALMCNT)=VALMCNT_U_+TIUY(TIUI)_U_PREFIX ; original
- . S ^TMP("TIUR",$J,"IEN",+^TMP("TIUYARRAY",$J,TIUI),VALMCNT)="" ; TIU*1.0*143
- . ; S ^TMP("TIUR",$J,"IEN",+TIUY(TIUI),VALMCNT)="" ;original
- . S ^TMP("TIUR",$J,"IDX",VALMCNT,VALMCNT)=""
- . ; TIUGDATA = 0 or DA^haskid^IDparent^prmsort:
- . S TIUGDATA=$$IDDATA^TIURECL1(+^TMP("TIUYARRAY",$J,TIUI),TIUD0) ; TIU*1.0*143
- . ; S TIUGDATA=$$IDDATA^TIURECL1(+TIUY(TIUI),TIUD0) ; original
- . I $G(TIUGDATA) S ^TMP("TIUR",$J,"IDDATA",+^TMP("TIUYARRAY",$J,TIUI))=TIUGDATA ; TIU*1.0*143
- . ; I $G(TIUGDATA) S ^TMP("TIUR",$J,"IDDATA",+TIUY(TIUI))=TIUGDATA ; original
- S ^TMP("TIUR",$J,"#")=TIUPICK_"^1:"_+VALMCNT
- S ^TMP("TIUR",$J,"CLASS")=CLASS
- S ^TMP("TIUR",$J,"DFN")=DFN
- S ^TMP("TIUR",$J,"OCC")=+$G(TIUOCC)
- S TIUOCTXT=CONTEXT
- I CONTEXT=4 S TIUOCTXT=TIUOCTXT_U_TIUDUZ
- I CONTEXT=5 S TIUOCTXT=TIUOCTXT_U_+TIUERLY_U_+TIULATE
- S ^TMP("TIUR",$J,"SEQ")=$G(TIUSEQ)
- S ^TMP("TIUR",$J,"CTXT")=$S('+$G(TIUCCTXT)&(VALMCNT'<TIUOCC):"INIT",1:TIUOCTXT)
- I CONTEXT=1,(+$G(TIUOCC)=9999999) D SAVE^TIUROR1
- I +$G(TIUCCTXT),$D(^TMP("TIUR",$J,0)) D HDR
- ; If first build (not rebuild), expand parents to show kids that
- ;meet criteria:
- I '$G(TIURBLD),$D(TIUEXPKD) D
- . D EXPANDKD^TIUR2(.TIUEXPKD,"",CONTEXT)
- ; K ^TMP("TIUYARRAY",$J) ; TIU*1.0*143
- Q
- ;
- EXIT ; -- exit code
- D CLEAN^VALM10
- K DFN,VALMY,VALMCNT,VALMKEY,^TMP("TIURSAVE",$J)
- K ^TMP("TIURIDX",$J)
- K TIUGLINK ;**100**
- Q
- ;
- RBLD ; -- rebuild list after actions
- N TIUEXP,TIURBLD
- S TIURBLD=1
- I +$O(^TMP("TIUR",$J,"EXPAND",0)) D G RBLDX
- . M TIUEXP=^TMP("TIUR",$J,"EXPAND")
- . D INIT(+$G(^TMP("TIUR",$J,"CLASS")),+$G(^("CTXT")),+$G(^("DFN")),+$G(^("OCC")))
- . D RELOAD^TIUROR1(.TIUEXP)
- . D BREATHE^TIUROR1(1)
- D INIT(+$G(^TMP("TIUR",$J,"CLASS")),+$G(^("CTXT")),+$G(^("DFN")),+$G(^("OCC")))
- ;D HDR S VALMBCK="R",VALMBG=1,VALMCNT=+$G(^TMP("TIUR",$J,0))
- D HDR S VALMBCK="R",VALMCNT=+$G(^TMP("TIUR",$J,0))
- RBLDX I $G(VALMBG)>$G(VALMCNT) S VALMBG=$G(VALMCNT)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUROR 8872 printed Feb 19, 2025@00:11:54 Page 2
- 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
- +2 ; Split rtn into TIUROR & TIUROR1 11/27/00
- EN ; -- main entry point for TIU OE/RR REVIEW PN
- +1 DO EN^VALM("TIU OE/RR REVIEW PN")
- +2 QUIT
- +3 ;
- HDR ; -- header code
- +1 NEW TIUCTXT,TIUPNM,TIUSSN,TIULOC,TIUDOB,TIUHDR,TIUCWAD,TIUDCNT,VADM,VA
- +2 NEW TIUDFN
- IF +$DATA(@VALMAR@(0))'>0
- SET VALMQUIT=1
- QUIT
- +3 SET TIUDFN=+$GET(@VALMAR@("DFN"))
- +4 SET TIUCWAD=$$CWAD^GMRPNOR1(TIUDFN)
- if TIUCWAD]""
- SET TIUCWAD="<"_TIUCWAD_">"
- +5 SET TIUDCNT=$JUSTIFY($SELECT($GET(@VALMAR@("CTXT"))="INIT":"Last ",1:"")_+@VALMAR@(0)_" note(s)",16)
- +6 SET TIUCTXT=$$UP^XLFSTR($$PNAME^TIULC1(@VALMAR@("CLASS")))
- +7 SET TIUCTXT=$$TITLE^TIUU(TIUCTXT)
- +8 SET TIUHDR=$$SETSTR^VALM1(TIUCWAD,$GET(TIUHDR),1,20)
- +9 SET TIUHDR=$$SETSTR^VALM1(TIUCTXT,$GET(TIUHDR),27,28)
- +10 SET TIUHDR=$$SETSTR^VALM1(TIUDCNT,$GET(TIUHDR),64,16)
- +11 SET VALMHDR(1)=TIUHDR
- SET TIUHDR=""
- +12 SET TIUPNM=$$NAME^TIULO(TIUDFN)
- SET TIUSSN=$$SSN^TIULO(TIUDFN)
- +13 SET TIUDOB=$$DOB^TIULO(TIUDFN)_" ("_$$AGE^TIULO(TIUDFN)_")"
- +14 SET TIULOC=$GET(^DPT(+TIUDFN,.1))
- +15 if TIULOC]""
- SET TIULOC=TIULOC_"/"_$GET(^DPT(+TIUDFN,.101))
- +16 SET TIUHDR=$$SETSTR^VALM1(TIUPNM,$GET(TIUHDR),1,20)
- +17 SET TIUHDR=$$SETSTR^VALM1(TIUSSN,$GET(TIUHDR),22,11)
- +18 SET TIUHDR=$$SETSTR^VALM1(TIULOC,$GET(TIUHDR),35,20)
- +19 SET TIUHDR=$$SETSTR^VALM1(TIUDOB,$GET(TIUHDR),64,16)
- +20 SET VALMHDR(2)=TIUHDR
- +21 QUIT
- +22 ;
- INIT(CLASS,CONTEXT,DFN,TIUOCC) ; -- init variables and list array
- +1 NEW TIUR,TIUI,TIUY,TIUPICK,TIUQUIT,TIUCCTXT,TIUDUZ,TIUERLY,TIULATE
- +2 NEW TIUPREF,TIUOCTXT,TIURCTXT,TIUSEQ,TIUDPRM
- +3 ;1/8/01
- NEW DUOUT,DTOUT,DIROUT
- +4 IF $GET(@VALMAR@("SEQ"))]""
- SET TIUSEQ=$GET(@VALMAR@("SEQ"))
- +5 IF +$GET(@VALMAR@("CTXT"))
- SET TIURCTXT=$GET(@VALMAR@("CTXT"))
- +6 KILL @VALMAR,VALMCNT,^TMP("TIURIDX",$JOB)
- +7 ; TIU*1.0*143
- KILL ^TMP("TIUYARRAY",$JOB)
- +8 SET TIUPREF=$$PERSPRF^TIULE(DUZ)
- +9 SET TIUSEQ=$GET(TIUSEQ,$SELECT($PIECE(TIUPREF,U,4)="A":"A",1:"D"))
- +10 SET TIUPICK=+$ORDER(^ORD(101,"B","TIU ACTION SELECT LIST ELEMENT",0))
- +11 SET DFN=$SELECT(+$GET(DFN):+$GET(DFN),+$GET(ORVP):+$GET(ORVP),1:+$$PATIENT^TIULA)
- +12 IF $SELECT($DATA(DUOUT):1,$DATA(DTOUT):1,$DATA(DIROUT):1,+$GET(DFN)'>0:1,1:0)
- SET VALMQUIT=1
- QUIT
- +13 IF +$GET(CONTEXT)'=9999
- IF '+$GET(TIUOCC)
- SET TIUOCC=$SELECT(+$PIECE(TIUPREF,U,10):+$PIECE(TIUPREF,U,10),1:100)
- +14 SET ^TMP("TIUR",$JOB,"RTN")="TIUROR"
- +15 IF '$ORDER(^TIU(8925,"ACLPT",CLASS,DFN,0))
- IF '$ORDER(^TIU(8925,"ACLAU",CLASS,DUZ,DFN,0))
- IF '$ORDER(^TIU(8925,"ACLEC",CLASS,DUZ,DFN,0))
- Begin DoDot:1
- +16 NEW TIUST
- +17 SET TIUST=$SELECT(CONTEXT=2:"UNSIGNED ",CONTEXT=3:"UNCOSIGNED ",1:"SIGNED ")
- +18 SET VALMCNT=2
- SET ^TMP("TIUR",$JOB,0)=0
- +19 SET ^TMP("TIUR",$JOB,1,0)=""
- +20 SET ^TMP("TIUR",$JOB,2,0)="No "_TIUST_$$UP^XLFSTR($$PNAME^TIULC1(CLASS))_" Available for "_$$PTNAME^TIULC1(DFN)
- +21 SET TIUOCTXT=CONTEXT
- +22 IF CONTEXT=4
- SET TIUOCTXT=TIUOCTXT_U_TIUDUZ
- +23 IF CONTEXT=5
- SET TIUOCTXT=TIUOCTXT_U_+TIUERLY_U_+TIULATE
- +24 SET ^TMP("TIUR",$JOB,"SEQ")=$GET(TIUSEQ)
- +25 SET ^TMP("TIUR",$JOB,"CLASS")=CLASS
- SET ^("DFN")=DFN
- SET ^("CTXT")=TIUOCTXT
- DO HDR
- End DoDot:1
- if $GET(CONTEXT)'=9999
- QUIT
- +26 IF $GET(CONTEXT)=9999
- SET TIUCCTXT=1
- SET TIUOCC=9999999
- +27 ; -- Set vars needed for RBLD if user ^s:
- +28 SET ^TMP("TIUR",$JOB,"CLASS")=CLASS
- SET ^("DFN")=DFN
- SET ^("OCC")=TIUOCC
- SET ^("CTXT")=+$GET(TIURCTXT)
- +29 SET CONTEXT=$SELECT($GET(CONTEXT)=9999:$$ASKCTXT^TIUROR1,+$GET(CONTEXT):+$GET(CONTEXT),1:1)
- +30 ; -- 1=Signed 2=Unsigned 3=Uncosigned 4=Signed/Author 5=Signed/Date --
- +31 IF $SELECT($DATA(DIROUT):1,$DATA(DUOUT):1,$DATA(DTOUT):1,1:0)
- DO RBLD
- QUIT
- +32 IF $SELECT(CONTEXT=1:1,CONTEXT=2:1,CONTEXT=3:1,1:0)
- SET TIUERLY=""
- SET TIULATE=""
- SET TIUDUZ=DUZ
- +33 IF CONTEXT=4
- Begin DoDot:1
- +34 SET TIUERLY=""
- SET TIULATE=""
- +35 SET TIUDUZ=$SELECT(+$GET(TIURCTXT)'=4:+$$AUTHOR^TIULA2(1),+$PIECE(TIURCTXT,U,2)'>0:+$$AUTHOR^TIULA2(1),+$GET(TIUCCTXT):+$$AUTHOR^TIULA2(1),1:+$PIECE(TIURCTXT,U,2))
- +36 ; changed DIRUT to DTOUT. 10/20/00
- IF $SELECT($DATA(DUOUT):1,$DATA(DTOUT):1,$DATA(DIROUT):1,+$GET(TIUDUZ)'>0:1,1:0)
- SET TIUQUIT=1
- DO RBLD
- QUIT
- +37 SET TIUSEQ=$SELECT(+$GET(TIUCCTXT):$PIECE($$ASKSEQ^TIULA3(TIUSEQ),U),$GET(TIUSEQ)']"":$PIECE($$ASKSEQ^TIULA3(TIUSEQ),U),1:$GET(TIUSEQ))
- +38 IF $SELECT($DATA(DIROUT):1,$DATA(DUOUT):1,$DATA(DTOUT):1,1:0)
- SET TIUQUIT=1
- DO RBLD
- End DoDot:1
- if +$GET(TIUQUIT)>0
- QUIT
- +39 IF CONTEXT=5
- Begin DoDot:1
- +40 SET TIUDUZ=+$GET(DUZ)
- +41 SET TIUERLY=$SELECT(+$GET(TIURCTXT)'=5:$$EDATE^TIULA("",7,""),+$PIECE(TIURCTXT,U,2)'>0:$$EDATE^TIULA("",7,""),+$GET(TIUCCTXT):$$EDATE^TIULA("",7,""),1:+$PIECE(TIURCTXT,U,2))
- +42 IF $SELECT($DATA(DIROUT):1,$DATA(DUOUT):1,$DATA(DTOUT):1,1:0)
- SET TIUQUIT=1
- DO RBLD
- QUIT
- +43 SET TIUERLY=$PIECE(TIUERLY,U)
- +44 SET TIULATE=$SELECT(+$GET(TIURCTXT)'=5:$$LDATE^TIULA("",7,""),+$PIECE(TIURCTXT,U,3)'>0:$$LDATE^TIULA("",7,""),+$GET(TIUCCTXT):$$LDATE^TIULA("",7,""),1:+$PIECE(TIURCTXT,U,3))
- +45 IF $SELECT($DATA(DIROUT):1,$DATA(DUOUT):1,$DATA(DTOUT):1,1:0)
- SET TIUQUIT=1
- DO RBLD
- QUIT
- +46 SET TIULATE=$PIECE(TIULATE,U)
- +47 IF TIUERLY>TIULATE
- DO SWAP^TIUR(.TIUERLY,.TIULATE)
- +48 IF $LENGTH(TIULATE,".")=1
- DO EXPRANGE^TIUR(.TIUERLY,.TIULATE)
- +49 SET TIUSEQ=$SELECT(+$GET(TIUCCTXT):$PIECE($$ASKSEQ^TIULA3(TIUSEQ),U),$GET(TIUSEQ)']"":$PIECE($$ASKSEQ^TIULA3(TIUSEQ),U),1:$GET(TIUSEQ))
- +50 IF $SELECT($DATA(DIROUT):1,$DATA(DUOUT):1,$DATA(DTOUT):1,1:0)
- SET TIUQUIT=1
- DO RBLD
- End DoDot:1
- if +$GET(TIUQUIT)>0
- QUIT
- +51 IF '$GET(TIURBLD)
- WRITE !,"Searching for the progress notes"
- +52 NEW TIUEXPKD
- +53 DO CONTEXT^TIUSRVLL(.TIUY,CLASS,CONTEXT,DFN,TIUERLY,TIULATE,TIUDUZ,TIUOCC,TIUSEQ,.TIUEXPKD)
- WRITE "."
- +54 ; I $D(TIUY)'>9 D Q ; original code
- +55 ; TIU*1.0*143
- IF $DATA(^TMP("TIUYARRAY",$JOB))'>9
- Begin DoDot:1
- +56 NEW TIUST
- +57 SET TIUST=$SELECT(CONTEXT=2:"UNSIGNED ",CONTEXT=3:"UNCOSIGNED ",1:"SIGNED ")
- +58 SET VALMCNT=2
- SET ^TMP("TIUR",$JOB,0)=0
- +59 SET ^TMP("TIUR",$JOB,1,0)=""
- +60 SET ^TMP("TIUR",$JOB,2,0)="No "_TIUST_$$UP^XLFSTR($$PNAME^TIULC1(CLASS))_" Available for "_$$PTNAME^TIULC1(DFN)
- +61 SET ^TMP("TIUR",$JOB,"CLASS")=CLASS
- SET ^("DFN")=DFN
- +62 SET TIUOCTXT=CONTEXT
- +63 IF CONTEXT=4
- SET TIUOCTXT=TIUOCTXT_U_TIUDUZ
- +64 IF CONTEXT=5
- SET TIUOCTXT=TIUOCTXT_U_+TIUERLY_U_+TIULATE
- +65 SET ^TMP("TIUR",$JOB,"SEQ")=$GET(TIUSEQ)
- +66 SET ^TMP("TIUR",$JOB,"CTXT")=$SELECT('+$GET(TIUCCTXT):"INIT",1:TIUOCTXT)
- DO HDR
- End DoDot:1
- QUIT
- +67 SET TIUI=""
- +68 ; F S TIUI=$O(TIUY(TIUI)) Q:TIUI="" D ; original code
- +69 ; TIU*1.0*143
- FOR
- SET TIUI=$ORDER(^TMP("TIUYARRAY",$JOB,TIUI))
- if TIUI=""
- QUIT
- Begin DoDot:1
- +70 NEW AUT,RDT,STAT,TITL,TIUD0,TIUD12,TIUD13,PREFIX
- +71 NEW TIUGDATA
- +72 ; **
- SET TIUD0=$GET(^TIU(8925,+^TMP("TIUYARRAY",$JOB,TIUI),0))
- SET TIUD12=$GET(^(12))
- SET TIUD13=$GET(^(13))
- +73 ; S TIUD0=$G(^TIU(8925,+TIUY(TIUI),0)),TIUD12=$G(^(12)),TIUD13=$G(^(13)) ; original
- +74 SET VALMCNT=+$GET(VALMCNT)+1
- if (VALMCNT#100'>0)
- WRITE "."
- +75 SET TITL=$$PNAME^TIULC1(+TIUD0)
- +76 IF TITL="Addendum"
- SET TITL=TITL_" to "_$$PNAME^TIULC1(+$GET(^TIU(8925,+$PIECE(TIUD0,U,6),0)))
- +77 ; -- Mark ID note '<' and/or has addendum '+',
- +78 ; TIU*1.0*143
- SET PREFIX=$$PREFIX^TIULA2(+^TMP("TIUYARRAY",$JOB,TIUI),0)
- +79 ; S PREFIX=$$PREFIX^TIULA2(+TIUY(TIUI),0) ; original
- +80 SET TITL=PREFIX_TITL
- +81 SET AUT=$$NAME^TIULS($$PERSNAME^TIULC1(+$PIECE(TIUD12,U,2)),"LAST,FI")
- +82 SET RDT=$$DATE^TIULS(+TIUD13,"MM/DD/YY HR:MIN")
- +83 SET STAT=$$LOW^XLFSTR($PIECE($GET(^TIU(8925.6,+$PIECE(TIUD0,U,5),0)),U))
- +84 SET TIUR=$$SETFLD^VALM1(VALMCNT,$GET(TIUR),"NUMBER")
- +85 SET TIUR=$$SETFLD^VALM1(TITL,$GET(TIUR),"TITLE")
- +86 SET TIUR=$$SETFLD^VALM1(AUT,$GET(TIUR),"AUTHOR")
- +87 SET TIUR=$$SETFLD^VALM1(RDT,$GET(TIUR),"REF DATE")
- +88 SET TIUR=$$SETFLD^VALM1(STAT,$GET(TIUR),"STATUS")
- +89 SET ^TMP("TIUR",$JOB,VALMCNT,0)=TIUR
- +90 SET ^TMP("TIUR",$JOB,0)=VALMCNT
- +91 ; TIU*1.0*143
- SET ^TMP("TIURIDX",$JOB,VALMCNT)=VALMCNT_U_+^TMP("TIUYARRAY",$JOB,TIUI)_U_PREFIX
- +92 ; S ^TMP("TIURIDX",$J,VALMCNT)=VALMCNT_U_+TIUY(TIUI)_U_PREFIX ; original
- +93 ; TIU*1.0*143
- SET ^TMP("TIUR",$JOB,"IEN",+^TMP("TIUYARRAY",$JOB,TIUI),VALMCNT)=""
- +94 ; S ^TMP("TIUR",$J,"IEN",+TIUY(TIUI),VALMCNT)="" ;original
- +95 SET ^TMP("TIUR",$JOB,"IDX",VALMCNT,VALMCNT)=""
- +96 ; TIUGDATA = 0 or DA^haskid^IDparent^prmsort:
- +97 ; TIU*1.0*143
- SET TIUGDATA=$$IDDATA^TIURECL1(+^TMP("TIUYARRAY",$JOB,TIUI),TIUD0)
- +98 ; S TIUGDATA=$$IDDATA^TIURECL1(+TIUY(TIUI),TIUD0) ; original
- +99 ; TIU*1.0*143
- IF $GET(TIUGDATA)
- SET ^TMP("TIUR",$JOB,"IDDATA",+^TMP("TIUYARRAY",$JOB,TIUI))=TIUGDATA
- +100 ; I $G(TIUGDATA) S ^TMP("TIUR",$J,"IDDATA",+TIUY(TIUI))=TIUGDATA ; original
- End DoDot:1
- +101 SET ^TMP("TIUR",$JOB,"#")=TIUPICK_"^1:"_+VALMCNT
- +102 SET ^TMP("TIUR",$JOB,"CLASS")=CLASS
- +103 SET ^TMP("TIUR",$JOB,"DFN")=DFN
- +104 SET ^TMP("TIUR",$JOB,"OCC")=+$GET(TIUOCC)
- +105 SET TIUOCTXT=CONTEXT
- +106 IF CONTEXT=4
- SET TIUOCTXT=TIUOCTXT_U_TIUDUZ
- +107 IF CONTEXT=5
- SET TIUOCTXT=TIUOCTXT_U_+TIUERLY_U_+TIULATE
- +108 SET ^TMP("TIUR",$JOB,"SEQ")=$GET(TIUSEQ)
- +109 SET ^TMP("TIUR",$JOB,"CTXT")=$SELECT('+$GET(TIUCCTXT)&(VALMCNT'<TIUOCC):"INIT",1:TIUOCTXT)
- +110 IF CONTEXT=1
- IF (+$GET(TIUOCC)=9999999)
- DO SAVE^TIUROR1
- +111 IF +$GET(TIUCCTXT)
- IF $DATA(^TMP("TIUR",$JOB,0))
- DO HDR
- +112 ; If first build (not rebuild), expand parents to show kids that
- +113 ;meet criteria:
- +114 IF '$GET(TIURBLD)
- IF $DATA(TIUEXPKD)
- Begin DoDot:1
- +115 DO EXPANDKD^TIUR2(.TIUEXPKD,"",CONTEXT)
- End DoDot:1
- +116 ; K ^TMP("TIUYARRAY",$J) ; TIU*1.0*143
- +117 QUIT
- +118 ;
- EXIT ; -- exit code
- +1 DO CLEAN^VALM10
- +2 KILL DFN,VALMY,VALMCNT,VALMKEY,^TMP("TIURSAVE",$JOB)
- +3 KILL ^TMP("TIURIDX",$JOB)
- +4 ;**100**
- KILL TIUGLINK
- +5 QUIT
- +6 ;
- RBLD ; -- rebuild list after actions
- +1 NEW TIUEXP,TIURBLD
- +2 SET TIURBLD=1
- +3 IF +$ORDER(^TMP("TIUR",$JOB,"EXPAND",0))
- Begin DoDot:1
- +4 MERGE TIUEXP=^TMP("TIUR",$JOB,"EXPAND")
- +5 DO INIT(+$GET(^TMP("TIUR",$JOB,"CLASS")),+$GET(^("CTXT")),+$GET(^("DFN")),+$GET(^("OCC")))
- +6 DO RELOAD^TIUROR1(.TIUEXP)
- +7 DO BREATHE^TIUROR1(1)
- End DoDot:1
- GOTO RBLDX
- +8 DO INIT(+$GET(^TMP("TIUR",$JOB,"CLASS")),+$GET(^("CTXT")),+$GET(^("DFN")),+$GET(^("OCC")))
- +9 ;D HDR S VALMBCK="R",VALMBG=1,VALMCNT=+$G(^TMP("TIUR",$J,0))
- +10 DO HDR
- SET VALMBCK="R"
- SET VALMCNT=+$GET(^TMP("TIUR",$JOB,0))
- RBLDX IF $GET(VALMBG)>$GET(VALMCNT)
- SET VALMBG=$GET(VALMCNT)
- +1 QUIT