- 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 Feb 18, 2025@23:51:47 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