Routine: TIURPN

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)

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."

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

CLEAN ; Clean up your mess!

 K ^TMP("TIUR",$J),^TMP("TIURIDX",$J) D CLEAN^VALM10

 K VALMY

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIURPN   3847     printed  Mar 13, 2025@21:50:23                                                                                                                                                                                                      Page 2

TIURPN    ; SLC/JER - QUICK Review BY PATIENT ;2/28/01

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**100**;Jun 20, 1997

EN(TIUCLASS,DFN) ; Entry point for build code

 +1        NEW DIRUT,DTOUT,DUOUT,TIUI,SCREEN,STATUS,TIUTYP,TIUSTAT,TIUEDFLT,TIUDCL

 +2        NEW TIUDPRMT,TIUPICT,TIUOUT

 +3        KILL DIROUT

 +4        SET TIUEDT=$$FMADD^XLFDT(DT,$SELECT($DATA(^DPT(DFN,.1))'>0:-180,1:-30))

 +5        SET TIULDT=+$$NOW^XLFDT

 +6        WRITE !,"Searching for the documents."

 +7        DO BUILD(TIUCLASS,DFN,TIUEDT,TIULDT)

 +8        QUIT

BUILD(CLASS,DFN,EARLY,LATE) ; Build List

 +1        NEW TIUCNT,TIUDT,TIUI,TIUJ,TIUK,TIUP,TIUQ,TIUDA,TIUREC

 +2        NEW TIUT,TIUTP,XREF,TIUS,TIUPREF,TIUPICK

 +3        SET (TIUK,VALMCNT)=0

 +4        KILL ^TMP("TIUR",$JOB),^TMP("TIURIDX",$JOB)

 +5        SET EARLY=9999999-+$GET(EARLY)

           SET LATE=9999999-+$GET(LATE)

 +6        SET TIUJ=LATE

 +7        SET TIUPICK=+$ORDER(^ORD(101,"B","TIU ACTION SELECT LIST ELEMENT",0))

 +8        FOR

               SET TIUJ=$ORDER(^TIU(8925,"APTCL",DFN,CLASS,TIUJ))

               if +TIUJ'>0!(+TIUJ>EARLY)

                   QUIT

               Begin DoDot:1

 +9                SET TIUDA=0

 +10               FOR

                       SET TIUDA=$ORDER(^TIU(8925,"APTCL",DFN,CLASS,TIUJ,TIUDA))

                       if +TIUDA'>0

                           QUIT

                       Begin DoDot:2

 +11                       DO ADDELMNT(TIUDA,.TIUCNT)

                       End DoDot:2

               End DoDot:1

 +12       SET ^TMP("TIUR",$JOB,0)=+$GET(TIUCNT)_U_"ALL^APT^"_DFN

 +13       SET ^TMP("TIUR",$JOB,0)=^TMP("TIUR",$JOB,0)_U_$PIECE(^DPT(DFN,0),U)

 +14       SET ^TMP("TIUR",$JOB,"CLASS")=TIUCLASS

 +15       SET ^TMP("TIUR",$JOB,"#")=TIUPICK_"^1:"_+$GET(TIUCNT)

 +16       IF $DATA(VALMHDR)>9

               DO HDR^TIURH

 +17       SET VALMCNT=+$GET(TIUCNT)

 +18       IF +$GET(TIUCNT)'>0

               Begin DoDot:1

 +19               SET ^TMP("TIUR",$JOB,1,0)=""

                   SET VALMCNT=2

 +20               SET ^TMP("TIUR",$JOB,2,0)="     No records found to satisfy search criteria."

               End DoDot:1

 +21       QUIT

ADDELMNT(DA,TIUCNT) ; Add each element to the list

 +1        NEW DIC,DIQ,DR,TIUR,PT,MOM,ADT,DDT,LCT,AUT,AMD,EDT,SDT,XDT,RMD,TIULST4

 +2        NEW TIUP,TIUREC,TIUD0,TIUD12,TIUD13,TIUD15,TIULI,STATX,DOC,IDKIDFLG

 +3        IF '$DATA(^TIU(8925,DA,0))

               QUIT

 +4        IF $GET(^TMP("TIUR",$JOB,2,0))="     No records found to satisfy search criteria."

               Begin DoDot:1

 +5                KILL ^TMP("TIUR",$JOB,2),^TMP("TIUR",$JOB,"IDX",2),^TMP("TIUR",$JOB,"IDX",1)

                   SET TIUCNT=0

               End DoDot:1

 +6        SET TIUD0=$GET(^TIU(8925,+DA,0))

           SET TIUD12=$GET(^TIU(8925,+DA,12))

 +7        SET TIUD13=$GET(^TIU(8925,+DA,13))

           SET TIUD15=$GET(^TIU(8925,+DA,15))

 +8        IF +TIUD0=81

               IF (+$PIECE(TIUD0,U,5)>5)

                   QUIT

 +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 PT=$$NAME^TIULS($$PTNAME^TIULC1($PIECE(TIUD0,U,2)),"LAST,FI MI")

 +12       SET TIULI=$EXTRACT(PT)

           SET IDKIDFLG=1

 +13      ;**100**

           IF +$ORDER(^TIU(8925,"DAD",+DA,0))

               IF $$HASADDEN^TIULC1(DA,IDKIDFLG)

                   SET PT="+ "_PT

 +14       SET TIUP=$$URGENCY(+DA)

 +15       if TIUP=1

               SET PT=$SELECT(PT["+":"*",1:"* ")_PT

 +16       SET TIULST4=$EXTRACT($PIECE($GET(^DPT(+$PIECE(TIUD0,U,2),0)),U,9),6,9)

 +17       SET TIULST4="("_TIULI_TIULST4_")"

 +18       SET ADT=$$DATE^TIULS($PIECE(TIUD0,U,7),"MM/DD/YY")

 +19       SET DDT=$$DATE^TIULS($PIECE(TIUD0,U,8),"MM/DD/YY")

 +20       SET AMD=$$PERSNAME^TIULC1($PIECE(TIUD12,U,8))

           if AMD="UNKNOWN"

               SET AMD=""

 +21       SET AUT=$$PERSNAME^TIULC1($PIECE(TIUD12,U,2))

           if AUT="UNKNOWN"

               SET AUT=""

 +22       SET AMD=$$NAME^TIULS(AMD,"LAST,FI MI")

 +23       SET AUT=$$NAME^TIULS(AUT,"LAST,FI MI")

 +24       SET EDT=$$DATE^TIULS($PIECE(TIUD13,U),"MM/DD/YY")

 +25       SET SDT=$SELECT(+$PIECE(TIUD15,U,7):+$PIECE(TIUD15,U,7),+$PIECE(TIUD0,U,5)'<7:+$PIECE(TIUD15,U),1:"")

 +26       SET SDT=$$DATE^TIULS(SDT,"MM/DD/YY")

 +27       SET STATX=$PIECE($GET(^TIU(8925.6,+$PIECE(TIUD0,U,5),0)),U)

 +28       SET TIUCNT=+$GET(TIUCNT)+1

 +29       SET TIUREC=$$SETFLD^VALM1(TIUCNT,"","NUMBER")

 +30       SET TIUREC=$$SETFLD^VALM1(PT,TIUREC,"PATIENT NAME")

 +31       SET TIUREC=$$SETFLD^VALM1(TIULST4,TIUREC,"LAST I/LAST 4")

 +32       SET TIUREC=$$SETFLD^VALM1(DOC,TIUREC,"DOCUMENT TYPE")

 +33       SET TIUREC=$$SETFLD^VALM1(EDT,TIUREC,"REF DATE")

 +34       SET TIUREC=$$SETFLD^VALM1(SDT,TIUREC,"SIG DATE")

 +35       SET TIUREC=$$SETFLD^VALM1($$LOWER^TIULS(STATX),TIUREC,"STATUS")

 +36       SET TIUREC=$$SETFLD^VALM1(AUT,TIUREC,"AUTHOR")

 +37       SET TIUREC=$$SETFLD^VALM1(AMD,TIUREC,"COSIGNER")

 +38       SET ^TMP("TIUR",$JOB,TIUCNT,0)=TIUREC

 +39       SET ^TMP("TIUR",$JOB,"IDX",TIUCNT,TIUCNT)=""

           if TIUCNT#10'>0

               WRITE "."

 +40       SET ^TMP("TIURIDX",$JOB,TIUCNT)=TIUCNT_U_DA

 +41       SET VALMCNT=TIUCNT

 +42       QUIT

CLEAN     ; Clean up your mess!

 +1        KILL ^TMP("TIUR",$JOB),^TMP("TIURIDX",$JOB)

           DO CLEAN^VALM10

 +2        KILL VALMY

 +3        QUIT

URGENCY(TIUDA) ; What is the urgency of the current document

 +1        NEW TIUY,TIUD0,TIUDSTAT,TIUDURG

 +2        SET TIUD0=$GET(^TIU(8925,+TIUDA,0))

           SET TIUDSTAT=$PIECE(TIUD0,U,5)

 +3        SET TIUDURG=$PIECE(TIUD0,U,9)

 +4        SET TIUY=$SELECT(TIUDSTAT<7:$SELECT(TIUDURG="P":1,1:2),1:3)

 +5        QUIT TIUY

TIURPN.m