VAQEXT06 ;ALB/JFP - CONTINUATION ROUTINE FOR VAQEXT01;20-MAY-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
DISMAX ; -- Displays the segments which exceed the max time & occur limits
Q:'$D(MAXARR)
Q:'$D(@MAXARR)
S SEGDE="",SEGMENT=""
S X=$$SETSTR^VALM1("Segments exceeding maximum time and occurrence limits:","",1,80) D TMP^VAQEXT01
F S SEGDE=$O(@MAXARR@(SEGDE)) Q:SEGDE="" D
.S SEG=$P($G(^VAT(394.71,SEGDE,0)),U,2)
.I ($L(SEGMENT_", "_SEG)>80) D
..S X=$$SETSTR^VALM1($E(SEGMENT,1,$L(SEGMENT-1)),"",1,80) D TMP^VAQEXT01
..S SEGMENT=""
.S:SEGMENT'="" SEGMENT=SEGMENT_", "_SEG
.S:SEGMENT="" SEGMENT=" "_SEGMENT_SEG
S X=$$SETSTR^VALM1(SEGMENT,"",1,80) D TMP^VAQEXT01
K @MAXARR,MAXARR
QUIT
;
SEG ; -- Gather segments into display lines
I '$D(^VAT(394.61,TRDE,"SEG",0)) D QUIT
.S SEGMENT($J,1)="No segments requested"
K SEGMENT($J)
N K,SEQ,SEGND,SEG,HSCOMPND,OLIMIT,TLIMIT
S K=1,SEQ=0
S:'$D(SEGMENT($J,K)) SEGMENT($J,K)=""
F S SEQ=$O(^VAT(394.61,TRDE,"SEG",SEQ)) Q:'SEQ D
.S SEGND=$G(^VAT(394.61,TRDE,"SEG",SEQ,0))
.S SEGDE=+$P(SEGND,U,1),TLIMIT=$P(SEGND,U,2),OLIMIT=$P(SEGND,U,3)
.S SEG=$P($G(^VAT(394.71,SEGDE,0)),U,2)
.S HSCOMPND=$$HLTHSEG^VAQDBIH3(SEG,0)
.I $P(HSCOMPND,U,1)'=0 D SEGDIS1
.S SEG=$E(SEG_" ",1,15) ; -- 15 spaces
.I $L(SEGMENT($J,K)_SEG)>69 S K=K+1,SEGMENT($J,K)=""
.S SEGMENT($J,K)=SEGMENT($J,K)_SEG
K SEQ
QUIT
;
SEGDIS ; -- Sets up segment display
S SEGND=$G(^TMP("VAQSEG",$J,DOM,SEG))
S TLIMIT=$P(SEGND,U,3)
S OLIMIT=$P(SEGND,U,4)
SEGDIS1 ;
I (TLIMIT="")&($P(HSCOMPND,U,2)=0) S TLIMIT="NA"
I (OLIMIT="")&($P(HSCOMPND,U,3)=0) S OLIMIT="NA"
I (TLIMIT="NA")&(OLIMIT="NA") QUIT
S SEG=SEG_" ["_TLIMIT_":"_OLIMIT_"]"
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQEXT06 1741 printed Sep 23, 2025@20:01:24 Page 2
VAQEXT06 ;ALB/JFP - CONTINUATION ROUTINE FOR VAQEXT01;20-MAY-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
DISMAX ; -- Displays the segments which exceed the max time & occur limits
+1 if '$DATA(MAXARR)
QUIT
+2 if '$DATA(@MAXARR)
QUIT
+3 SET SEGDE=""
SET SEGMENT=""
+4 SET X=$$SETSTR^VALM1("Segments exceeding maximum time and occurrence limits:","",1,80)
DO TMP^VAQEXT01
+5 FOR
SET SEGDE=$ORDER(@MAXARR@(SEGDE))
if SEGDE=""
QUIT
Begin DoDot:1
+6 SET SEG=$PIECE($GET(^VAT(394.71,SEGDE,0)),U,2)
+7 IF ($LENGTH(SEGMENT_", "_SEG)>80)
Begin DoDot:2
+8 SET X=$$SETSTR^VALM1($EXTRACT(SEGMENT,1,$LENGTH(SEGMENT-1)),"",1,80)
DO TMP^VAQEXT01
+9 SET SEGMENT=""
End DoDot:2
+10 if SEGMENT'=""
SET SEGMENT=SEGMENT_", "_SEG
+11 if SEGMENT=""
SET SEGMENT=" "_SEGMENT_SEG
End DoDot:1
+12 SET X=$$SETSTR^VALM1(SEGMENT,"",1,80)
DO TMP^VAQEXT01
+13 KILL @MAXARR,MAXARR
+14 QUIT
+15 ;
SEG ; -- Gather segments into display lines
+1 IF '$DATA(^VAT(394.61,TRDE,"SEG",0))
Begin DoDot:1
+2 SET SEGMENT($JOB,1)="No segments requested"
End DoDot:1
QUIT
+3 KILL SEGMENT($JOB)
+4 NEW K,SEQ,SEGND,SEG,HSCOMPND,OLIMIT,TLIMIT
+5 SET K=1
SET SEQ=0
+6 if '$DATA(SEGMENT($JOB,K))
SET SEGMENT($JOB,K)=""
+7 FOR
SET SEQ=$ORDER(^VAT(394.61,TRDE,"SEG",SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+8 SET SEGND=$GET(^VAT(394.61,TRDE,"SEG",SEQ,0))
+9 SET SEGDE=+$PIECE(SEGND,U,1)
SET TLIMIT=$PIECE(SEGND,U,2)
SET OLIMIT=$PIECE(SEGND,U,3)
+10 SET SEG=$PIECE($GET(^VAT(394.71,SEGDE,0)),U,2)
+11 SET HSCOMPND=$$HLTHSEG^VAQDBIH3(SEG,0)
+12 IF $PIECE(HSCOMPND,U,1)'=0
DO SEGDIS1
+13 ; -- 15 spaces
SET SEG=$EXTRACT(SEG_" ",1,15)
+14 IF $LENGTH(SEGMENT($JOB,K)_SEG)>69
SET K=K+1
SET SEGMENT($JOB,K)=""
+15 SET SEGMENT($JOB,K)=SEGMENT($JOB,K)_SEG
End DoDot:1
+16 KILL SEQ
+17 QUIT
+18 ;
SEGDIS ; -- Sets up segment display
+1 SET SEGND=$GET(^TMP("VAQSEG",$JOB,DOM,SEG))
+2 SET TLIMIT=$PIECE(SEGND,U,3)
+3 SET OLIMIT=$PIECE(SEGND,U,4)
SEGDIS1 ;
+1 IF (TLIMIT="")&($PIECE(HSCOMPND,U,2)=0)
SET TLIMIT="NA"
+2 IF (OLIMIT="")&($PIECE(HSCOMPND,U,3)=0)
SET OLIMIT="NA"
+3 IF (TLIMIT="NA")&(OLIMIT="NA")
QUIT
+4 SET SEG=SEG_" ["_TLIMIT_":"_OLIMIT_"]"
+5 QUIT
