| 1 | QAMAHO5 ;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 | ;
|
|---|
| 4 | SET ;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
|
|---|
| 15 | SET1 D LOOP
|
|---|
| 16 | Q
|
|---|
| 17 | FREE ;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
|
|---|
| 28 | FREE1 D LOOP
|
|---|
| 29 | Q
|
|---|
| 30 | EVENT ;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
|
|---|
| 35 | EVENT1 ;
|
|---|
| 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
|
|---|
| 39 | LOOP ;
|
|---|
| 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
|
|---|
| 42 | LOOP1 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
|
|---|
