source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIURPN.m@ 1397

TIURPN ; SLC/JER - QUICK Review BY PATIENT ;2/28/01
 ;;1.0;TEXT INTEGRATION UTILITIES;**100**;Jun 20, 1997
EN(TIUCLASS,DFN) ; Entry point for build code
 N DIRUT,DTOUT,DUOUT,TIUI,SCREEN,STATUS,TIUTYP,TIUSTAT,TIUEDFLT,TIUDCL
 N TIUDPRMT,TIUPICT,TIUOUT
 K DIROUT
 S TIUEDT=$$FMADD^XLFDT(DT,$S($D(^DPT(DFN,.1))'>0:-180,1:-30))
 S TIULDT=+$$NOW^XLFDT
 W !,"Searching for the documents."
 D BUILD(TIUCLASS,DFN,TIUEDT,TIULDT)
 Q
BUILD(CLASS,DFN,EARLY,LATE) ; Build List
 N TIUCNT,TIUDT,TIUI,TIUJ,TIUK,TIUP,TIUQ,TIUDA,TIUREC
 N TIUT,TIUTP,XREF,TIUS,TIUPREF,TIUPICK
 S (TIUK,VALMCNT)=0
 K ^TMP("TIUR",$J),^TMP("TIURIDX",$J)
 S EARLY=9999999-+$G(EARLY),LATE=9999999-+$G(LATE)
 S TIUJ=LATE
 S TIUPICK=+$O(^ORD(101,"B","TIU ACTION SELECT LIST ELEMENT",0))
 F  S TIUJ=$O(^TIU(8925,"APTCL",DFN,CLASS,TIUJ)) Q:+TIUJ'>0!(+TIUJ>EARLY)  D
 . S TIUDA=0
 . F  S TIUDA=$O(^TIU(8925,"APTCL",DFN,CLASS,TIUJ,TIUDA)) Q:+TIUDA'>0  D
 . . D ADDELMNT(TIUDA,.TIUCNT)
 S ^TMP("TIUR",$J,0)=+$G(TIUCNT)_U_"ALL^APT^"_DFN
 S ^TMP("TIUR",$J,0)=^TMP("TIUR",$J,0)_U_$P(^DPT(DFN,0),U)
 S ^TMP("TIUR",$J,"CLASS")=TIUCLASS
 S ^TMP("TIUR",$J,"#")=TIUPICK_"^1:"_+$G(TIUCNT)
 I $D(VALMHDR)>9 D HDR^TIURH
 S VALMCNT=+$G(TIUCNT)
 I +$G(TIUCNT)'>0 D
 . S ^TMP("TIUR",$J,1,0)="",VALMCNT=2
 . S ^TMP("TIUR",$J,2,0)="     No records found to satisfy search criteria."
 Q
ADDELMNT(DA,TIUCNT) ; Add each element to the list
 N DIC,DIQ,DR,TIUR,PT,MOM,ADT,DDT,LCT,AUT,AMD,EDT,SDT,XDT,RMD,TIULST4
 N TIUP,TIUREC,TIUD0,TIUD12,TIUD13,TIUD15,TIULI,STATX,DOC,IDKIDFLG
 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))
 I +TIUD0=81,(+$P(TIUD0,U,5)>5) Q
 S DOC=$$PNAME^TIULC1(+TIUD0)
 I DOC="Addendum" S DOC=DOC_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUD0,U,6),0)))
 S PT=$$NAME^TIULS($$PTNAME^TIULC1($P(TIUD0,U,2)),"LAST,FI MI")
 S TIULI=$E(PT),IDKIDFLG=1
 I +$O(^TIU(8925,"DAD",+DA,0)),$$HASADDEN^TIULC1(DA,IDKIDFLG) S PT="+ "_PT ;**100**
 S TIUP=$$URGENCY(+DA)
 S:TIUP=1 PT=$S(PT["+":"*",1:"* ")_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(SDT,TIUREC,"SIG DATE")
 S TIUREC=$$SETFLD^VALM1($$LOWER^TIULS(STATX),TIUREC,"STATUS")
 S TIUREC=$$SETFLD^VALM1(AUT,TIUREC,"AUTHOR")
 S TIUREC=$$SETFLD^VALM1(AMD,TIUREC,"COSIGNER")
 S ^TMP("TIUR",$J,TIUCNT,0)=TIUREC
 S ^TMP("TIUR",$J,"IDX",TIUCNT,TIUCNT)="" W:TIUCNT#10'>0 "."
 S ^TMP("TIURIDX",$J,TIUCNT)=TIUCNT_U_DA
 S VALMCNT=TIUCNT
 Q
CLEAN ; Clean up your mess!
 K ^TMP("TIUR",$J),^TMP("TIURIDX",$J) D CLEAN^VALM10
 K VALMY
 Q
URGENCY(TIUDA) ; What is the urgency of the current document
 N TIUY,TIUD0,TIUDSTAT,TIUDURG
 S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUDSTAT=$P(TIUD0,U,5)
 S TIUDURG=$P(TIUD0,U,9)
 S TIUY=$S(TIUDSTAT<7:$S(TIUDURG="P":1,1:2),1:3)
 Q TIUY