TIUSRVLC.m

TIUSRVLC ; SLC/JER - Server functions for lists ;06/19/97 16:22

 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997

NOTES(TIUY,DFN,EARLY,LATE,ROOTFLAG) ; Gets list of Notes

 I $S(+$G(DFN)'>0:1,'$D(^DPT(+$G(DFN),0)):1,1:0) Q

 D LIST(.TIUY,3,DFN,$G(EARLY),$G(LATE),$G(ROOTFLAG))

 Q

SUMMARY(TIUY,DFN,EARLY,LATE,ROOTFLAG) ; Gets list of Summaries

 I $S(+$G(DFN)'>0:1,'$D(^DPT(+$G(DFN),0)):1,1:0) Q

 D LIST(.TIUY,244,DFN,$G(EARLY),$G(LATE),$G(ROOTFLAG))

 Q

CONSULT(TIUY,DFN,EARLY,LATE,ROOTFLAG) ; Gets list of Consults

 I $S(+$G(DFN)'>0:1,'$D(^DPT(+$G(DFN),0)):1,1:0) Q

 D LIST(.TIUY,243,STATUS,QSTR,$G(EARLY),$G(LATE),$G(ROOTFLAG))

 Q

LIST(TIUY,CLASS,DFN,EARLY,LATE,ROOTFLAG) ; Build List

 N TIUCNT,TIUDT,TIUI,TIUJ,TIUK,TIUP,TIUQ,TIUREC,TIUPRM0,TIUPRM1

 N TIUPRM3,TIUT,TIUTP,XREF,TIUS,TIUCONT,TIUSTAT,TIUTYPE

 K ^TMP("TIULIST",$J),^TMP("TIUI",$J)

 I '$D(TIUPRM0) D SETPARM^TIULE

 S EARLY=9999999-+$G(EARLY)

 S (TIUI,LATE)=9999999-$S(+$G(LATE):+$G(LATE),1:3333333)

 F  S TIUI=$O(^TIU(8925,"APTCL",DFN,CLASS,TIUI)) Q:+TIUI'>0!(+TIUI>EARLY)  D GATHER(DFN,CLASS,TIUI,ROOTFLAG)

 I +$O(^TMP("TIULIST",$J,0)) S TIUY=$NA(^TMP("TIULIST",$J)),(TIUI,TIUK)=0

 Q

GATHER(DFN,CLASS,TIUI,ROOTFLAG) ; Find/sort records for the list

 N TIUDA

 I '$D(TIUDPRM0) D SETPARM^TIULE

 S TIUDA=0

 F  S TIUDA=$O(^TIU(8925,"APTCL",DFN,CLASS,TIUI,TIUDA)) Q:+TIUDA'>0  D

 . I ($P(TIUPRM0,U,6)="S"),(+$$CANDO^TIULP(TIUDA,"VIEW")'>0) Q

 . D ADDELMNT(TIUDA,.TIUCNT,ROOTFLAG)

 Q

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

 N DOC,LOC,PT,AUT,EDT,TIUPT,TIULST4,TIUREC,TIUR0,TIUR12,TIUR13

 N STATUS,EDTCNT,LOCTYP,TIUADT,TIUDDT,TIUSUBJ

 S TIUR0=$G(^TIU(8925,+DA,0)),TIUR12=$G(^TIU(8925,+DA,12))

 S TIUR13=$G(^TIU(8925,+DA,13)),TIUPT=$G(^DPT(+$P(TIUR0,U,2),0))

 S TIUSUBJ=$G(^TIU(8925,+DA,17))

 I '+$P(TIUR0,U,7) D

 . S $P(TIUR0,U,7)=+$G(^AUPNVSIT(+$P(TIUR0,U,3),0))

 . I '+$P(TIUR0,U,7) S $P(TIUR0,U,7)=""

 S DOC=$$PNAME^TIULC1(+TIUR0)

 I DOC="Addendum" S DOC=DOC_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUR0,U,6),0)))

 I +$$HASADDEN^TIULC1(+DA) S DOC="+ "_DOC

 I +$$URGENCY^TIURM(+DA)=1 S DOC=$S(DOC["+":"*",1:"* ")_DOC

 S STATUS=$$LOWER^TIULS($P($G(^TIU(8925.6,+$P(TIUR0,U,5),0)),U))

 S LOC=$G(^SC(+$P(TIUR12,U,5),0)),LOCTYP=$P(LOC,U,3),LOC=$P(LOC,U)

 S TIUADT=$S(LOCTYP="W":"Adm: ",1:"Visit: ")_$$DATE^TIULS($P(TIUR0,U,7),"MM/DD/YY")

 S TIUDDT=$S(+$P(TIUR0,U,8):"Dis: ",1:"")_$$DATE^TIULS($P(TIUR0,U,8),"MM/DD/YY")

 S PT=$$NAME^TIULS($P(TIUPT,U),"LAST, FIRST MI")

 S TIULST4=$E($P(TIUPT,U,9),6,9)

 S TIULST4="("_$E(PT)_TIULST4_")"

 S AUT=$$SIGNAME^TIULS(+$P(TIUR12,U,2))

 S EDT=+TIUR13

 S TIUCNT=+$G(TIUCNT)+1

 S TIUREC=DA_U_DOC_U_EDT_U_PT_" "_TIULST4_U_AUT_U_LOC_U_STATUS_U_TIUADT_U_TIUDDT_U

 I ($L(TIUREC)+$L(TIUSUBJ))>255 S TIUSUBJ=$E(TIUSUBJ,1,(255-$L(TIUREC)))

 S TIUREC=TIUREC_TIUSUBJ

 S ^TMP("TIULIST",$J,TIUCNT)=TIUREC

 S:+$G(ROOTFLAG) $P(^TMP("TIULIST",$J),U)=TIUCNT

 S:+$G(ROOTFLAG)&(TIUCNT=1) $P(^TMP("TIULIST",$J),U,3)=EDT

 S:+$G(ROOTFLAG) $P(^TMP("TIULIST",$J),U,2)=EDT

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---TIUSRVLC   3021     printed  Feb 19, 2025@00:12:19                                                                                                                                                                                                    Page 2

TIUSRVLC  ; SLC/JER - Server functions for lists ;06/19/97 16:22

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

NOTES(TIUY,DFN,EARLY,LATE,ROOTFLAG) ; Gets list of Notes

 +1        IF $SELECT(+$GET(DFN)'>0:1,'$DATA(^DPT(+$GET(DFN),0)):1,1:0)

               QUIT 

 +2        DO LIST(.TIUY,3,DFN,$GET(EARLY),$GET(LATE),$GET(ROOTFLAG))

 +3        QUIT 

SUMMARY(TIUY,DFN,EARLY,LATE,ROOTFLAG) ; Gets list of Summaries

 +1        IF $SELECT(+$GET(DFN)'>0:1,'$DATA(^DPT(+$GET(DFN),0)):1,1:0)

               QUIT 

 +2        DO LIST(.TIUY,244,DFN,$GET(EARLY),$GET(LATE),$GET(ROOTFLAG))

 +3        QUIT 

CONSULT(TIUY,DFN,EARLY,LATE,ROOTFLAG) ; Gets list of Consults

 +1        IF $SELECT(+$GET(DFN)'>0:1,'$DATA(^DPT(+$GET(DFN),0)):1,1:0)

               QUIT 

 +2        DO LIST(.TIUY,243,STATUS,QSTR,$GET(EARLY),$GET(LATE),$GET(ROOTFLAG))

 +3        QUIT 

LIST(TIUY,CLASS,DFN,EARLY,LATE,ROOTFLAG) ; Build List

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

 +2        NEW TIUPRM3,TIUT,TIUTP,XREF,TIUS,TIUCONT,TIUSTAT,TIUTYPE

 +3        KILL ^TMP("TIULIST",$JOB),^TMP("TIUI",$JOB)

 +4        IF '$DATA(TIUPRM0)

               DO SETPARM^TIULE

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

 +6        SET (TIUI,LATE)=9999999-$SELECT(+$GET(LATE):+$GET(LATE),1:3333333)

 +7        FOR 

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

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

                   QUIT 

               DO GATHER(DFN,CLASS,TIUI,ROOTFLAG)

 +8        IF +$ORDER(^TMP("TIULIST",$JOB,0))

               SET TIUY=$NAME(^TMP("TIULIST",$JOB))

               SET (TIUI,TIUK)=0

 +9        QUIT 

GATHER(DFN,CLASS,TIUI,ROOTFLAG) ; Find/sort records for the list

 +1        NEW TIUDA

 +2        IF '$DATA(TIUDPRM0)

               DO SETPARM^TIULE

 +3        SET TIUDA=0

 +4        FOR 

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

               if +TIUDA'>0

                   QUIT 

               Begin DoDot:1

 +5                IF ($PIECE(TIUPRM0,U,6)="S")

                       IF (+$$CANDO^TIULP(TIUDA,"VIEW")'>0)

                           QUIT 

 +6                DO ADDELMNT(TIUDA,.TIUCNT,ROOTFLAG)

               End DoDot:1

 +7        QUIT 

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

 +1        NEW DOC,LOC,PT,AUT,EDT,TIUPT,TIULST4,TIUREC,TIUR0,TIUR12,TIUR13

 +2        NEW STATUS,EDTCNT,LOCTYP,TIUADT,TIUDDT,TIUSUBJ

 +3        SET TIUR0=$GET(^TIU(8925,+DA,0))

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

 +4        SET TIUR13=$GET(^TIU(8925,+DA,13))

           SET TIUPT=$GET(^DPT(+$PIECE(TIUR0,U,2),0))

 +5        SET TIUSUBJ=$GET(^TIU(8925,+DA,17))

 +6        IF '+$PIECE(TIUR0,U,7)

               Begin DoDot:1

 +7                SET $PIECE(TIUR0,U,7)=+$GET(^AUPNVSIT(+$PIECE(TIUR0,U,3),0))

 +8                IF '+$PIECE(TIUR0,U,7)

                       SET $PIECE(TIUR0,U,7)=""

               End DoDot:1

 +9        SET DOC=$$PNAME^TIULC1(+TIUR0)

 +10       IF DOC="Addendum"

               SET DOC=DOC_" to "_$$PNAME^TIULC1(+$GET(^TIU(8925,+$PIECE(TIUR0,U,6),0)))

 +11       IF +$$HASADDEN^TIULC1(+DA)

               SET DOC="+ "_DOC

 +12       IF +$$URGENCY^TIURM(+DA)=1

               SET DOC=$SELECT(DOC["+":"*",1:"* ")_DOC

 +13       SET STATUS=$$LOWER^TIULS($PIECE($GET(^TIU(8925.6,+$PIECE(TIUR0,U,5),0)),U))

 +14       SET LOC=$GET(^SC(+$PIECE(TIUR12,U,5),0))

           SET LOCTYP=$PIECE(LOC,U,3)

           SET LOC=$PIECE(LOC,U)

 +15       SET TIUADT=$SELECT(LOCTYP="W":"Adm: ",1:"Visit: ")_$$DATE^TIULS($PIECE(TIUR0,U,7),"MM/DD/YY")

 +16       SET TIUDDT=$SELECT(+$PIECE(TIUR0,U,8):"Dis: ",1:"")_$$DATE^TIULS($PIECE(TIUR0,U,8),"MM/DD/YY")

 +17       SET PT=$$NAME^TIULS($PIECE(TIUPT,U),"LAST, FIRST MI")

 +18       SET TIULST4=$EXTRACT($PIECE(TIUPT,U,9),6,9)

 +19       SET TIULST4="("_$EXTRACT(PT)_TIULST4_")"

 +20       SET AUT=$$SIGNAME^TIULS(+$PIECE(TIUR12,U,2))

 +21       SET EDT=+TIUR13

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

 +23       SET TIUREC=DA_U_DOC_U_EDT_U_PT_" "_TIULST4_U_AUT_U_LOC_U_STATUS_U_TIUADT_U_TIUDDT_U

 +24       IF ($LENGTH(TIUREC)+$LENGTH(TIUSUBJ))>255

               SET TIUSUBJ=$EXTRACT(TIUSUBJ,1,(255-$LENGTH(TIUREC)))

 +25       SET TIUREC=TIUREC_TIUSUBJ

 +26       SET ^TMP("TIULIST",$JOB,TIUCNT)=TIUREC

 +27       if +$GET(ROOTFLAG)

               SET $PIECE(^TMP("TIULIST",$JOB),U)=TIUCNT

 +28       if +$GET(ROOTFLAG)&(TIUCNT=1)

               SET $PIECE(^TMP("TIULIST",$JOB),U,3)=EDT

 +29       if +$GET(ROOTFLAG)

               SET $PIECE(^TMP("TIULIST",$JOB),U,2)=EDT

 +30       QUIT