DVBABTIU.m

DVBABTIU ;ALB/SPH - CAPRI TIU UTILITIES ;05/01/03

 ;;2.7;AMIE;**53**;Apr 10, 1995

 ;

NOTETL(Y) ; Returns list of TIU titles sorted by title

 N DVBCNT,DVBIEN

 S DVBCNT=0,DVBIEN=0,DVBDOCNM=""

 F  S DVBDOCNM=$O(^TIU(8925.1,"B",DVBDOCNM)) Q:DVBDOCNM=""  D

   .F  S DVBIEN=$O(^TIU(8925.1,"B",DVBDOCNM,DVBIEN)) Q:'DVBIEN  D

 ..;S DVBDOCNM=$P($G(^TIU(8925.1,DVBIEN,0)),"^",1)

 ..S DVBDOCTY=$P($G(^TIU(8925.1,DVBIEN,0)),"^",4)

 ..S DVBDOCST=$P($G(^TIU(8925.1,DVBIEN,0)),"^",7)

 ..S Y(DVBCNT)=DVBDOCTY_"  "_DVBDOCNM_"  "_DVBDOCST_"  IEN#"_DVBIEN,DVBCNT=DVBCNT+1

 Q

VISIT(DVBVISIT,DVBPAT,DVBVDT,DVBCLIN) ;

 N DVBIEN

 S DVBIEN=0 F  S DVBIEN=$O(^AUPNVSIT("B",DVBVDT,DVBIEN)) Q:DVBIEN=""  D

 . I $P($G(^AUPNVSIT(DVBIEN,0)),U,5)=DVBPAT D

 .. I $P($G(^AUPNVSIT(DVBIEN,0)),U,22)=DVBCLIN S DVBVISIT=DVBIEN_"^"_$P($G(^AUPNVSIT(DVBIEN,150)),U)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DVBABTIU   847     printed  Apr 09, 2024@20:53:17                                                                                                                                                                                                     Page 2

DVBABTIU  ;ALB/SPH - CAPRI TIU UTILITIES ;05/01/03

 +1       ;;2.7;AMIE;**53**;Apr 10, 1995

 +2       ;

NOTETL(Y) ; Returns list of TIU titles sorted by title

 +1        NEW DVBCNT,DVBIEN

 +2        SET DVBCNT=0

           SET DVBIEN=0

           SET DVBDOCNM=""

 +3        FOR 

               SET DVBDOCNM=$ORDER(^TIU(8925.1,"B",DVBDOCNM))

               if DVBDOCNM=""

                   QUIT 

               Begin DoDot:1

 +4                FOR 

                       SET DVBIEN=$ORDER(^TIU(8925.1,"B",DVBDOCNM,DVBIEN))

                       if 'DVBIEN

                           QUIT 

                       Begin DoDot:2

 +5       ;S DVBDOCNM=$P($G(^TIU(8925.1,DVBIEN,0)),"^",1)

 +6                        SET DVBDOCTY=$PIECE($GET(^TIU(8925.1,DVBIEN,0)),"^",4)

 +7                        SET DVBDOCST=$PIECE($GET(^TIU(8925.1,DVBIEN,0)),"^",7)

 +8                        SET Y(DVBCNT)=DVBDOCTY_"  "_DVBDOCNM_"  "_DVBDOCST_"  IEN#"_DVBIEN

                           SET DVBCNT=DVBCNT+1

                       End DoDot:2

               End DoDot:1

 +9        QUIT 

VISIT(DVBVISIT,DVBPAT,DVBVDT,DVBCLIN) ;

 +1        NEW DVBIEN

 +2        SET DVBIEN=0

           FOR 

               SET DVBIEN=$ORDER(^AUPNVSIT("B",DVBVDT,DVBIEN))

               if DVBIEN=""

                   QUIT 

               Begin DoDot:1

 +3                IF $PIECE($GET(^AUPNVSIT(DVBIEN,0)),U,5)=DVBPAT

                       Begin DoDot:2

 +4                        IF $PIECE($GET(^AUPNVSIT(DVBIEN,0)),U,22)=DVBCLIN

                               SET DVBVISIT=DVBIEN_"^"_$PIECE($GET(^AUPNVSIT(DVBIEN,150)),U)

                       End DoDot:2

               End DoDot:1

 +5        QUIT