source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQEXT06.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1VAQEXT06 ;ALB/JFP - CONTINUATION ROUTINE FOR VAQEXT01;20-MAY-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3DISMAX ; -- Displays the segments which exceed the max time & occur limits
4 Q:'$D(MAXARR)
5 Q:'$D(@MAXARR)
6 S SEGDE="",SEGMENT=""
7 S X=$$SETSTR^VALM1("Segments exceeding maximum time and occurrence limits:","",1,80) D TMP^VAQEXT01
8 F S SEGDE=$O(@MAXARR@(SEGDE)) Q:SEGDE="" D
9 .S SEG=$P($G(^VAT(394.71,SEGDE,0)),U,2)
10 .I ($L(SEGMENT_", "_SEG)>80) D
11 ..S X=$$SETSTR^VALM1($E(SEGMENT,1,$L(SEGMENT-1)),"",1,80) D TMP^VAQEXT01
12 ..S SEGMENT=""
13 .S:SEGMENT'="" SEGMENT=SEGMENT_", "_SEG
14 .S:SEGMENT="" SEGMENT=" "_SEGMENT_SEG
15 S X=$$SETSTR^VALM1(SEGMENT,"",1,80) D TMP^VAQEXT01
16 K @MAXARR,MAXARR
17 QUIT
18 ;
19SEG ; -- Gather segments into display lines
20 I '$D(^VAT(394.61,TRDE,"SEG",0)) D QUIT
21 .S SEGMENT($J,1)="No segments requested"
22 K SEGMENT($J)
23 N K,SEQ,SEGND,SEG,HSCOMPND,OLIMIT,TLIMIT
24 S K=1,SEQ=0
25 S:'$D(SEGMENT($J,K)) SEGMENT($J,K)=""
26 F S SEQ=$O(^VAT(394.61,TRDE,"SEG",SEQ)) Q:'SEQ D
27 .S SEGND=$G(^VAT(394.61,TRDE,"SEG",SEQ,0))
28 .S SEGDE=+$P(SEGND,U,1),TLIMIT=$P(SEGND,U,2),OLIMIT=$P(SEGND,U,3)
29 .S SEG=$P($G(^VAT(394.71,SEGDE,0)),U,2)
30 .S HSCOMPND=$$HLTHSEG^VAQDBIH3(SEG,0)
31 .I $P(HSCOMPND,U,1)'=0 D SEGDIS1
32 .S SEG=$E(SEG_" ",1,15) ; -- 15 spaces
33 .I $L(SEGMENT($J,K)_SEG)>69 S K=K+1,SEGMENT($J,K)=""
34 .S SEGMENT($J,K)=SEGMENT($J,K)_SEG
35 K SEQ
36 QUIT
37 ;
38SEGDIS ; -- Sets up segment display
39 S SEGND=$G(^TMP("VAQSEG",$J,DOM,SEG))
40 S TLIMIT=$P(SEGND,U,3)
41 S OLIMIT=$P(SEGND,U,4)
42SEGDIS1 ;
43 I (TLIMIT="")&($P(HSCOMPND,U,2)=0) S TLIMIT="NA"
44 I (OLIMIT="")&($P(HSCOMPND,U,3)=0) S OLIMIT="NA"
45 I (TLIMIT="NA")&(OLIMIT="NA") QUIT
46 S SEG=SEG_" ["_TLIMIT_":"_OLIMIT_"]"
47 QUIT
Note: See TracBrowser for help on using the repository browser.