- TIURTIT1 ; SLC/JER - Review Documents by TITLE ;4/18/03
- ;;1.0;TEXT INTEGRATION UTILITIES;**100,113**;Jun 20, 1997
- ; New rtn, created 12/6/00 when splitting TIURTITL
- GATHER(TIUI,TIUPREF,CLASS,STATIFNS,EARLY,LATE,XREF) ; Find/sort records for the list
- N TIUT,TIUTP,TIUS,TIUSTAT,TIUSFLD,TIUJ,TIUIFN,TIUQ
- 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 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,TIUSFLD
- N TIUEXPKD,FORGETAD
- 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^TIURTITH
- 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^TIURTITH
- . 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^TIURTITH
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIURTIT1 5750 printed Feb 19, 2025@00:12:04 Page 2
- TIURTIT1 ; SLC/JER - Review Documents by TITLE ;4/18/03
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**100,113**;Jun 20, 1997
- +2 ; New rtn, created 12/6/00 when splitting TIURTITL
- GATHER(TIUI,TIUPREF,CLASS,STATIFNS,EARLY,LATE,XREF) ; Find/sort records for the list
- +1 NEW TIUT,TIUTP,TIUS,TIUSTAT,TIUSFLD,TIUJ,TIUIFN,TIUQ
- +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 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 to LM Template
- +1 ;array
- +2 NEW TIUJ,TIUQ,TIUDA,TIUPICK,TIUORDER,TIUSFLD
- +3 NEW TIUEXPKD,FORGETAD
- +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^TIURTITH
- +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^TIURTITH
- +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^TIURTITH
- End DoDot:1
- +52 QUIT