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 ---[H[J[2J[HDVBABTIU 847 printed Dec 13, 2024@01:40:52 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
