source: WorldVistAEHR/trunk/r/CLINICAL_MONITORING_SYSTEM-QAM/QAMAHO5.m@ 1639

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

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1QAMAHO5 ;HISC/GJC-CHECKS SORT DATA FOR FALLOUT FILE ^QA(743.1 ;7/2/92 09:02
2 ;;1.0;Clinical Monitoring System;;09/13/1993
3 ;
4SET ;BEGINNING/ENDING SORT VALUES FOR SET OF CODES DATA ELEMENTS
5 S QAMELEM=QAMDIEN D EN1^QAMUTL2 W !!,"Enter the beginning and ending values for ",DIR("A"),".",!
6 K DIR("A"),DIR("B") S DIR("A")="Start with: First// ",DIR(0)=$P(DIR(0),U)_"A^"_$P(DIR(0),U,2)
7 D ^DIR I $D(DTOUT)!($D(DUOUT)) S QAMOUT=1 Q
8 I X="" S DATA1=" ",DATA2="~" G SET1
9 E S DATA1=Y(0)
10 S DIR("A")="End with: Last// "
11 S DATA1=Y D ^DIR I $D(DTOUT)!($D(DUOUT)) S QAMOUT=1 Q
12 I X="" S DATA2="~"
13 E S DATA2=Y(0)
14 I (DATA2']DATA1),(DATA1'=DATA2) W !!,*7,"The 'Start with' value must fall before the 'End with' value in the alphabet." G SET
15SET1 D LOOP
16 Q
17FREE ;BEGINNING/ENDING SORT VALUES FOR FREE TEXT DATA ELEMENTS
18 S QAMELEM=QAMDIEN D EN1^QAMUTL2 W !!,"Enter the beginning and ending values for ",DIR("A"),".",!
19 K DIR("A"),DIR("B") S DIR("A")="Start with: First// ",DIR(0)=$P(DIR(0),U)_"A^"_$P(DIR(0),U,2)
20 D ^DIR I $D(DTOUT)!($D(DUOUT)) S QAMOUT=1 Q
21 I X="" S DATA1=" ",DATA2="~" G FREE1
22 E S DATA1=Y
23 S DIR("A")="End with: Last// "
24 S DATA1=Y D ^DIR I $D(DTOUT)!($D(DUOUT)) S QAMOUT=1 Q
25 I X="" S DATA2="~"
26 E S DATA2=Y
27 I (DATA2']DATA1),(DATA1'=DATA2) W !!,*7,"The 'Start with' value must fall before the 'End with' value in the alphabet." G FREE
28FREE1 D LOOP
29 Q
30EVENT ;BEGINNING/ENDING SORT VALUES FOR EVENT DATE
31 W !!,"Enter the beginning and ending values for EVENT DATE."
32 D ^QAQDATE I QAQQUIT S (QAMQUIT,QAMOUT)=1 Q
33 F YZ=0:0 S YZ=$O(^QA(743.1,"AA",YZ)) Q:YZ'>0 F LP=(QAQNBEG-.0000001):0 S LP=$O(^QA(743.1,"AA",YZ,LP)) Q:(LP'>0)!(LP>QAQNEND) D EVENT1
34 Q
35EVENT1 ;
36 S Y=LP X ^DD("DD")
37 F QAMPT=0:0 S QAMPT=$O(^QA(743.1,"AA",YZ,LP,QAMPT)) Q:QAMPT'>0 F QAMD0=0:0 S QAMD0=$O(^QA(743.1,"AA",YZ,LP,QAMPT,QAMD0)) Q:QAMD0'>0 S ^UTILITY($J,"QAM DATE",LP,QAMD0)=Y
38 Q
39LOOP ;
40 S LP0="" F LP=0:0 S LP0=$O(^QA(743.1,"AD",QAMDIEN,LP0)) Q:LP0="" I (LP0]DATA1)!(LP0=DATA1),((DATA2]LP0)!(DATA2=LP0)) D LOOP1
41 Q
42LOOP1 F QAMD0=0:0 S QAMD0=$O(^QA(743.1,"AD",QAMDIEN,LP0,QAMD0)) Q:QAMD0'>0 S ^UTILITY($J,"QAM DLMNT",LP0,QAMD0)=LP0
43 Q
Note: See TracBrowser for help on using the repository browser.