TIURPTT1 ; SLC/JER - Review Documents by PATIENT & TITLE ;4/18/03
;;1.0;TEXT INTEGRATION UTILITIES;**100,113**;Jun 20, 1997
; 12/5/00 new rtn from splitting TIURPTTL
GATHER(TIUI,TIUPREF,CLASS,STATIFNS,EARLY,LATE,XREF) ; Find/sort records for the list
N TIUT,TIUTP,TIUS,TIUSTAT,TIUSFLD,TIUJ,TIUQ,TIUIFN
S TIUSFLD=$P(TIUPREF,U,3)
S TIUSFLD=$S(TIUSFLD="P":".02",TIUSFLD="D":".01",TIUSFLD="S":".05",TIUSFLD="C":"1507",TIUSFLD="A":"1202",TIUSFLD="E":"1208",1:"1301")
S TIUT=0 F S TIUT=$O(TYPES(TIUT)) Q:+TIUT'>0 D
. S TIUTP=+$P($G(TYPES(TIUT)),U,2) Q:TIUTP'>0
. S TIUS=1 F S TIUSTAT=$P(STATIFNS,";",TIUS) Q:'TIUSTAT D
. . S TIUS=TIUS+1
. . S TIUJ=LATE F S TIUJ=$O(^TIU(8925,XREF,TIUI,TIUTP,TIUSTAT,TIUJ)) Q:+TIUJ'>0!(+TIUJ>EARLY) D
. . . S TIUIFN=0
. . . F S TIUIFN=$O(^TIU(8925,XREF,TIUI,TIUTP,TIUSTAT,TIUJ,TIUIFN)) Q:+TIUIFN'>0 D
. . . . ;Consider adding view check here
. . . . I TIUTP=81,(+TYPES>1),($P(TYPES(TIUT),U,4)="NOT PICKED"),'+$$DADINTYP(TIUIFN,.TYPES) Q
. . . . S TIUQ=$$RESOLVE^TIUR1(TIUIFN,TIUSFLD)
. . . . S ^TMP("TIUI",$J,TIUQ,TIUJ,TIUIFN)=""
Q
DADINTYP(TIUDA,TYPES) ; Evaluates whether addendum's parent belongs is among
; the selected types
N TIUI,TIUDTYP,TIUY S (TIUI,TIUY)=0
S TIUDTYP=+$G(^TIU(8925,+$P($G(^TIU(8925,+TIUDA,0)),U,6),0))
F S TIUI=$O(TYPES(TIUI)) Q:+TIUI'>0!+TIUY D
. I +$P(TYPES(TIUI),U,2)=TIUDTYP S TIUY=1
Q TIUY
PUTLIST(TIUPREF,TIUCLASS,STATUS,SCREEN) ; Adds list elements
;to LM Template array
N TIUJ,TIUQ,TIUDA,TIUPICK,TIUORDER
N TIUEXPKD,FORGETAD,TIUSFLD
S VALMCNT=0
S TIUSFLD=$P(TIUPREF,U,3)
S TIUSFLD=$S(TIUSFLD="P":".02",TIUSFLD="D":".01",TIUSFLD="S":".05",TIUSFLD="C":"1507",TIUSFLD="A":"1202",TIUSFLD="E":"1208",1:"1301")
S TIUORDER=$S($P(TIUPREF,U,4)="D":-1,1:1)
S TIUPICK=+$O(^ORD(101,"B","TIU ACTION SELECT LIST ELEMENT",0))
S TIUQ="" F S TIUQ=$O(^TMP("TIUI",$J,TIUQ)) Q:TIUQ']"" D
. S TIUJ=0 F S TIUJ=$O(^TMP("TIUI",$J,TIUQ,TIUJ)) Q:+TIUJ'>0 D
. . S TIUDA=0
. . F S TIUDA=$O(^TMP("TIUI",$J,TIUQ,TIUJ,TIUDA)) Q:+TIUDA'>0 D
. . . S FORGETAD=1
. . . ; Replace ID kids/addenda in ^TMP("TIUI",$J) with
. . . ;their parents. Don't expand parent for sake of addm:
. . . D REPLACE^TIUR2(TIUDA,TIUQ,TIUSFLD,TIUJ,.TIUEXPKD,FORGETAD)
D SETLIST(TIUORDER,.VALMCNT)
S ^TMP("TIUR",$J,0)=+$G(VALMCNT)_U_STATUS("WORDS")
S TIUJ=0,SCREEN="" F S TIUJ=$O(SCREEN(TIUJ)) Q:+TIUJ'>0 D
. S SCREEN=$G(SCREEN)_$S(TIUJ>1:";",1:U)_SCREEN(TIUJ)
S ^TMP("TIUR",$J,0)=^TMP("TIUR",$J,0)_$G(SCREEN)
S ^TMP("TIUR",$J,"CLASS")=TIUCLASS
S ^TMP("TIUR",$J,"#")=TIUPICK_"^1:"_+$G(VALMCNT)
I $D(VALMHDR)>9 D HDR^TIURH
I +$G(VALMCNT)'>0 D
. S ^TMP("TIUR",$J,1,0)="",VALMCNT=2
. S ^TMP("TIUR",$J,2,0)=" No records found to satisfy search criteria."
; -- Expand to show kids that fit:
I '$G(TIURBLD),$D(TIUEXPKD) D EXPANDKD^TIUR2(.STATUS,.TIUEXPKD)
Q
;
SETLIST(TIUORDER,VALMCNT) ; Set items from ^TMP("TIUI",$J) into
;List Template list
N TIUSVAL,TIUDTM,TIUDA
S TIUSVAL=""
F S TIUSVAL=$O(^TMP("TIUI",$J,TIUSVAL),TIUORDER) Q:TIUSVAL="" D
. S TIUDTM=0
. F S TIUDTM=$O(^TMP("TIUI",$J,TIUSVAL,TIUDTM)) Q:'TIUDTM D
. . S TIUDA=0
. . F S TIUDA=$O(^TMP("TIUI",$J,TIUSVAL,TIUDTM,TIUDA)) Q:'TIUDA D
. . . D ADDELMNT(TIUDA,.VALMCNT)
Q
;
ADDELMNT(DA,TIUCNT,APPEND) ; Add each element to the list
N PT,ADT,DDT,AUT,AMD,EDT,SDT,TIULST4
N TIUREC,TIUD0,TIUD12,TIUD13,TIUD15,TIULI,STATX,DOC
N PREFIX,TIUGDATA
I '$D(^TIU(8925,DA,0)) Q
I $G(^TMP("TIUR",$J,2,0))=" No records found to satisfy search criteria." D
. K ^TMP("TIUR",$J,2),^TMP("TIUR",$J,"IDX",2),^TMP("TIUR",$J,"IDX",1) S TIUCNT=0
S TIUD0=$G(^TIU(8925,+DA,0)),TIUD12=$G(^TIU(8925,+DA,12))
S TIUD13=$G(^TIU(8925,+DA,13)),TIUD15=$G(^TIU(8925,+DA,15))
S DOC=$$PNAME^TIULC1(+TIUD0)
I DOC="Addendum" S DOC=DOC_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUD0,U,6),0)))
S PREFIX=$$PREFIX^TIULA2(DA,0)
S PT=$$NAME^TIULS($$PTNAME^TIULC1($P(TIUD0,U,2)),"LAST,FI MI")
S TIULI=$E(PT)
S PT=PREFIX_PT
S TIULST4=$E($P($G(^DPT(+$P(TIUD0,U,2),0)),U,9),6,9)
S TIULST4="("_TIULI_TIULST4_")"
S ADT=$$DATE^TIULS($P(TIUD0,U,7),"MM/DD/YY")
S DDT=$$DATE^TIULS($P(TIUD0,U,8),"MM/DD/YY")
S AMD=$$PERSNAME^TIULC1($P(TIUD12,U,8)) S:AMD="UNKNOWN" AMD=""
S AUT=$$PERSNAME^TIULC1($P(TIUD12,U,2)) S:AUT="UNKNOWN" AUT=""
S AMD=$$NAME^TIULS(AMD,"LAST, FI MI")
S AUT=$$NAME^TIULS(AUT,"LAST, FI MI")
S EDT=$$DATE^TIULS($P(TIUD13,U),"MM/DD/YY")
S SDT=$S(+$P(TIUD15,U,7):+$P(TIUD15,U,7),+$P(TIUD0,U,5)'<7:+$P(TIUD15,U),1:"")
S SDT=$$DATE^TIULS(SDT,"MM/DD/YY")
S STATX=$P($G(^TIU(8925.6,+$P(TIUD0,U,5),0)),U)
S TIUCNT=+$G(TIUCNT)+1
S TIUREC=$$SETFLD^VALM1(TIUCNT,"","NUMBER")
S TIUREC=$$SETFLD^VALM1(PT,TIUREC,"PATIENT NAME")
S TIUREC=$$SETFLD^VALM1(TIULST4,TIUREC,"LAST I/LAST 4")
S TIUREC=$$SETFLD^VALM1(DOC,TIUREC,"DOCUMENT TYPE")
S TIUREC=$$SETFLD^VALM1(EDT,TIUREC,"REF DATE")
S TIUREC=$$SETFLD^VALM1($$LOWER^TIULS(STATX),TIUREC,"STATUS")
S TIUREC=$$SETFLD^VALM1(SDT,TIUREC,"SIG DATE")
S TIUREC=$$SETFLD^VALM1(AUT,TIUREC,"AUTHOR")
S TIUREC=$$SETFLD^VALM1(AMD,TIUREC,"EXPECTED COSIGNER")
S ^TMP("TIUR",$J,TIUCNT,0)=TIUREC
S ^TMP("TIUR",$J,"IDX",TIUCNT,TIUCNT)="" W "."
S ^TMP("TIURIDX",$J,TIUCNT)=TIUCNT_U_DA_U_PREFIX
S ^TMP("TIUR",$J,"IEN",DA,TIUCNT)="" ;MARGY 11/11/00
S TIUGDATA=$$IDDATA^TIURECL1(DA,TIUD0)
I TIUGDATA S ^TMP("TIUR",$J,"IDDATA",DA)=TIUGDATA
S VALMCNT=TIUCNT
I +$G(APPEND) D
. D RESTORE^VALM10(TIUCNT)
. D CNTRL^VALM10(TIUCNT,1,$G(VALM("RM")),IOINHI,IOINORM),HDR^TIURH
. S VALMSG="** Item #"_TIUCNT_" Added **"
. S $P(^TMP("TIUR",$J,0),U)=TIUCNT
. S $P(^TMP("TIUR",$J,"#"),":",2)=TIUCNT
. S VALMCNT=TIUCNT
. I $D(VALMHDR)>9 D HDR^TIURH
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIURPTT1 5754 printed Nov 22, 2024@17:55:25 Page 2
TIURPTT1 ; SLC/JER - Review Documents by PATIENT & TITLE ;4/18/03
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**100,113**;Jun 20, 1997
+2 ; 12/5/00 new rtn from splitting TIURPTTL
GATHER(TIUI,TIUPREF,CLASS,STATIFNS,EARLY,LATE,XREF) ; Find/sort records for the list
+1 NEW TIUT,TIUTP,TIUS,TIUSTAT,TIUSFLD,TIUJ,TIUQ,TIUIFN
+2 SET TIUSFLD=$PIECE(TIUPREF,U,3)
+3 SET TIUSFLD=$SELECT(TIUSFLD="P":".02",TIUSFLD="D":".01",TIUSFLD="S":".05",TIUSFLD="C":"1507",TIUSFLD="A":"1202",TIUSFLD="E":"1208",1:"1301")
+4 SET TIUT=0
FOR
SET TIUT=$ORDER(TYPES(TIUT))
if +TIUT'>0
QUIT
Begin DoDot:1
+5 SET TIUTP=+$PIECE($GET(TYPES(TIUT)),U,2)
if TIUTP'>0
QUIT
+6 SET TIUS=1
FOR
SET TIUSTAT=$PIECE(STATIFNS,";",TIUS)
if 'TIUSTAT
QUIT
Begin DoDot:2
+7 SET TIUS=TIUS+1
+8 SET TIUJ=LATE
FOR
SET TIUJ=$ORDER(^TIU(8925,XREF,TIUI,TIUTP,TIUSTAT,TIUJ))
if +TIUJ'>0!(+TIUJ>EARLY)
QUIT
Begin DoDot:3
+9 SET TIUIFN=0
+10 FOR
SET TIUIFN=$ORDER(^TIU(8925,XREF,TIUI,TIUTP,TIUSTAT,TIUJ,TIUIFN))
if +TIUIFN'>0
QUIT
Begin DoDot:4
+11 ;Consider adding view check here
+12 IF TIUTP=81
IF (+TYPES>1)
IF ($PIECE(TYPES(TIUT),U,4)="NOT PICKED")
IF '+$$DADINTYP(TIUIFN,.TYPES)
QUIT
+13 SET TIUQ=$$RESOLVE^TIUR1(TIUIFN,TIUSFLD)
+14 SET ^TMP("TIUI",$JOB,TIUQ,TIUJ,TIUIFN)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
DADINTYP(TIUDA,TYPES) ; Evaluates whether addendum's parent belongs is among
+1 ; the selected types
+2 NEW TIUI,TIUDTYP,TIUY
SET (TIUI,TIUY)=0
+3 SET TIUDTYP=+$GET(^TIU(8925,+$PIECE($GET(^TIU(8925,+TIUDA,0)),U,6),0))
+4 FOR
SET TIUI=$ORDER(TYPES(TIUI))
if +TIUI'>0!+TIUY
QUIT
Begin DoDot:1
+5 IF +$PIECE(TYPES(TIUI),U,2)=TIUDTYP
SET TIUY=1
End DoDot:1
+6 QUIT TIUY
PUTLIST(TIUPREF,TIUCLASS,STATUS,SCREEN) ; Adds list elements
+1 ;to LM Template array
+2 NEW TIUJ,TIUQ,TIUDA,TIUPICK,TIUORDER
+3 NEW TIUEXPKD,FORGETAD,TIUSFLD
+4 SET VALMCNT=0
+5 SET TIUSFLD=$PIECE(TIUPREF,U,3)
+6 SET TIUSFLD=$SELECT(TIUSFLD="P":".02",TIUSFLD="D":".01",TIUSFLD="S":".05",TIUSFLD="C":"1507",TIUSFLD="A":"1202",TIUSFLD="E":"1208",1:"1301")
+7 SET TIUORDER=$SELECT($PIECE(TIUPREF,U,4)="D":-1,1:1)
+8 SET TIUPICK=+$ORDER(^ORD(101,"B","TIU ACTION SELECT LIST ELEMENT",0))
+9 SET TIUQ=""
FOR
SET TIUQ=$ORDER(^TMP("TIUI",$JOB,TIUQ))
if TIUQ']""
QUIT
Begin DoDot:1
+10 SET TIUJ=0
FOR
SET TIUJ=$ORDER(^TMP("TIUI",$JOB,TIUQ,TIUJ))
if +TIUJ'>0
QUIT
Begin DoDot:2
+11 SET TIUDA=0
+12 FOR
SET TIUDA=$ORDER(^TMP("TIUI",$JOB,TIUQ,TIUJ,TIUDA))
if +TIUDA'>0
QUIT
Begin DoDot:3
+13 SET FORGETAD=1
+14 ; Replace ID kids/addenda in ^TMP("TIUI",$J) with
+15 ;their parents. Don't expand parent for sake of addm:
+16 DO REPLACE^TIUR2(TIUDA,TIUQ,TIUSFLD,TIUJ,.TIUEXPKD,FORGETAD)
End DoDot:3
End DoDot:2
End DoDot:1
+17 DO SETLIST(TIUORDER,.VALMCNT)
+18 SET ^TMP("TIUR",$JOB,0)=+$GET(VALMCNT)_U_STATUS("WORDS")
+19 SET TIUJ=0
SET SCREEN=""
FOR
SET TIUJ=$ORDER(SCREEN(TIUJ))
if +TIUJ'>0
QUIT
Begin DoDot:1
+20 SET SCREEN=$GET(SCREEN)_$SELECT(TIUJ>1:";",1:U)_SCREEN(TIUJ)
End DoDot:1
+21 SET ^TMP("TIUR",$JOB,0)=^TMP("TIUR",$JOB,0)_$GET(SCREEN)
+22 SET ^TMP("TIUR",$JOB,"CLASS")=TIUCLASS
+23 SET ^TMP("TIUR",$JOB,"#")=TIUPICK_"^1:"_+$GET(VALMCNT)
+24 IF $DATA(VALMHDR)>9
DO HDR^TIURH
+25 IF +$GET(VALMCNT)'>0
Begin DoDot:1
+26 SET ^TMP("TIUR",$JOB,1,0)=""
SET VALMCNT=2
+27 SET ^TMP("TIUR",$JOB,2,0)=" No records found to satisfy search criteria."
End DoDot:1
+28 ; -- Expand to show kids that fit:
+29 IF '$GET(TIURBLD)
IF $DATA(TIUEXPKD)
DO EXPANDKD^TIUR2(.STATUS,.TIUEXPKD)
+30 QUIT
+31 ;
SETLIST(TIUORDER,VALMCNT) ; Set items from ^TMP("TIUI",$J) into
+1 ;List Template list
+2 NEW TIUSVAL,TIUDTM,TIUDA
+3 SET TIUSVAL=""
+4 FOR
SET TIUSVAL=$ORDER(^TMP("TIUI",$JOB,TIUSVAL),TIUORDER)
if TIUSVAL=""
QUIT
Begin DoDot:1
+5 SET TIUDTM=0
+6 FOR
SET TIUDTM=$ORDER(^TMP("TIUI",$JOB,TIUSVAL,TIUDTM))
if 'TIUDTM
QUIT
Begin DoDot:2
+7 SET TIUDA=0
+8 FOR
SET TIUDA=$ORDER(^TMP("TIUI",$JOB,TIUSVAL,TIUDTM,TIUDA))
if 'TIUDA
QUIT
Begin DoDot:3
+9 DO ADDELMNT(TIUDA,.VALMCNT)
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
ADDELMNT(DA,TIUCNT,APPEND) ; Add each element to the list
+1 NEW PT,ADT,DDT,AUT,AMD,EDT,SDT,TIULST4
+2 NEW TIUREC,TIUD0,TIUD12,TIUD13,TIUD15,TIULI,STATX,DOC
+3 NEW PREFIX,TIUGDATA
+4 IF '$DATA(^TIU(8925,DA,0))
QUIT
+5 IF $GET(^TMP("TIUR",$JOB,2,0))=" No records found to satisfy search criteria."
Begin DoDot:1
+6 KILL ^TMP("TIUR",$JOB,2),^TMP("TIUR",$JOB,"IDX",2),^TMP("TIUR",$JOB,"IDX",1)
SET TIUCNT=0
End DoDot:1
+7 SET TIUD0=$GET(^TIU(8925,+DA,0))
SET TIUD12=$GET(^TIU(8925,+DA,12))
+8 SET TIUD13=$GET(^TIU(8925,+DA,13))
SET TIUD15=$GET(^TIU(8925,+DA,15))
+9 SET DOC=$$PNAME^TIULC1(+TIUD0)
+10 IF DOC="Addendum"
SET DOC=DOC_" to "_$$PNAME^TIULC1(+$GET(^TIU(8925,+$PIECE(TIUD0,U,6),0)))
+11 SET PREFIX=$$PREFIX^TIULA2(DA,0)
+12 SET PT=$$NAME^TIULS($$PTNAME^TIULC1($PIECE(TIUD0,U,2)),"LAST,FI MI")
+13 SET TIULI=$EXTRACT(PT)
+14 SET PT=PREFIX_PT
+15 SET TIULST4=$EXTRACT($PIECE($GET(^DPT(+$PIECE(TIUD0,U,2),0)),U,9),6,9)
+16 SET TIULST4="("_TIULI_TIULST4_")"
+17 SET ADT=$$DATE^TIULS($PIECE(TIUD0,U,7),"MM/DD/YY")
+18 SET DDT=$$DATE^TIULS($PIECE(TIUD0,U,8),"MM/DD/YY")
+19 SET AMD=$$PERSNAME^TIULC1($PIECE(TIUD12,U,8))
if AMD="UNKNOWN"
SET AMD=""
+20 SET AUT=$$PERSNAME^TIULC1($PIECE(TIUD12,U,2))
if AUT="UNKNOWN"
SET AUT=""
+21 SET AMD=$$NAME^TIULS(AMD,"LAST, FI MI")
+22 SET AUT=$$NAME^TIULS(AUT,"LAST, FI MI")
+23 SET EDT=$$DATE^TIULS($PIECE(TIUD13,U),"MM/DD/YY")
+24 SET SDT=$SELECT(+$PIECE(TIUD15,U,7):+$PIECE(TIUD15,U,7),+$PIECE(TIUD0,U,5)'<7:+$PIECE(TIUD15,U),1:"")
+25 SET SDT=$$DATE^TIULS(SDT,"MM/DD/YY")
+26 SET STATX=$PIECE($GET(^TIU(8925.6,+$PIECE(TIUD0,U,5),0)),U)
+27 SET TIUCNT=+$GET(TIUCNT)+1
+28 SET TIUREC=$$SETFLD^VALM1(TIUCNT,"","NUMBER")
+29 SET TIUREC=$$SETFLD^VALM1(PT,TIUREC,"PATIENT NAME")
+30 SET TIUREC=$$SETFLD^VALM1(TIULST4,TIUREC,"LAST I/LAST 4")
+31 SET TIUREC=$$SETFLD^VALM1(DOC,TIUREC,"DOCUMENT TYPE")
+32 SET TIUREC=$$SETFLD^VALM1(EDT,TIUREC,"REF DATE")
+33 SET TIUREC=$$SETFLD^VALM1($$LOWER^TIULS(STATX),TIUREC,"STATUS")
+34 SET TIUREC=$$SETFLD^VALM1(SDT,TIUREC,"SIG DATE")
+35 SET TIUREC=$$SETFLD^VALM1(AUT,TIUREC,"AUTHOR")
+36 SET TIUREC=$$SETFLD^VALM1(AMD,TIUREC,"EXPECTED COSIGNER")
+37 SET ^TMP("TIUR",$JOB,TIUCNT,0)=TIUREC
+38 SET ^TMP("TIUR",$JOB,"IDX",TIUCNT,TIUCNT)=""
WRITE "."
+39 SET ^TMP("TIURIDX",$JOB,TIUCNT)=TIUCNT_U_DA_U_PREFIX
+40 ;MARGY 11/11/00
SET ^TMP("TIUR",$JOB,"IEN",DA,TIUCNT)=""
+41 SET TIUGDATA=$$IDDATA^TIURECL1(DA,TIUD0)
+42 IF TIUGDATA
SET ^TMP("TIUR",$JOB,"IDDATA",DA)=TIUGDATA
+43 SET VALMCNT=TIUCNT
+44 IF +$GET(APPEND)
Begin DoDot:1
+45 DO RESTORE^VALM10(TIUCNT)
+46 DO CNTRL^VALM10(TIUCNT,1,$GET(VALM("RM")),IOINHI,IOINORM)
DO HDR^TIURH
+47 SET VALMSG="** Item #"_TIUCNT_" Added **"
+48 SET $PIECE(^TMP("TIUR",$JOB,0),U)=TIUCNT
+49 SET $PIECE(^TMP("TIUR",$JOB,"#"),":",2)=TIUCNT
+50 SET VALMCNT=TIUCNT
+51 IF $DATA(VALMHDR)>9
DO HDR^TIURH
End DoDot:1
+52 QUIT
+53 ;
