QAMAHO5 ;HISC/GJC-CHECKS SORT DATA FOR FALLOUT FILE ^QA(743.1 ;7/2/92 09:02
;;1.0;Clinical Monitoring System;;09/13/1993
;
SET ;BEGINNING/ENDING SORT VALUES FOR SET OF CODES DATA ELEMENTS
S QAMELEM=QAMDIEN D EN1^QAMUTL2 W !!,"Enter the beginning and ending values for ",DIR("A"),".",!
K DIR("A"),DIR("B") S DIR("A")="Start with: First// ",DIR(0)=$P(DIR(0),U)_"A^"_$P(DIR(0),U,2)
D ^DIR I $D(DTOUT)!($D(DUOUT)) S QAMOUT=1 Q
I X="" S DATA1=" ",DATA2="~" G SET1
E S DATA1=Y(0)
S DIR("A")="End with: Last// "
S DATA1=Y D ^DIR I $D(DTOUT)!($D(DUOUT)) S QAMOUT=1 Q
I X="" S DATA2="~"
E S DATA2=Y(0)
I (DATA2']DATA1),(DATA1'=DATA2) W !!,*7,"The 'Start with' value must fall before the 'End with' value in the alphabet." G SET
SET1 D LOOP
Q
FREE ;BEGINNING/ENDING SORT VALUES FOR FREE TEXT DATA ELEMENTS
S QAMELEM=QAMDIEN D EN1^QAMUTL2 W !!,"Enter the beginning and ending values for ",DIR("A"),".",!
K DIR("A"),DIR("B") S DIR("A")="Start with: First// ",DIR(0)=$P(DIR(0),U)_"A^"_$P(DIR(0),U,2)
D ^DIR I $D(DTOUT)!($D(DUOUT)) S QAMOUT=1 Q
I X="" S DATA1=" ",DATA2="~" G FREE1
E S DATA1=Y
S DIR("A")="End with: Last// "
S DATA1=Y D ^DIR I $D(DTOUT)!($D(DUOUT)) S QAMOUT=1 Q
I X="" S DATA2="~"
E S DATA2=Y
I (DATA2']DATA1),(DATA1'=DATA2) W !!,*7,"The 'Start with' value must fall before the 'End with' value in the alphabet." G FREE
FREE1 D LOOP
Q
EVENT ;BEGINNING/ENDING SORT VALUES FOR EVENT DATE
W !!,"Enter the beginning and ending values for EVENT DATE."
D ^QAQDATE I QAQQUIT S (QAMQUIT,QAMOUT)=1 Q
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
Q
EVENT1 ;
S Y=LP X ^DD("DD")
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
Q
LOOP ;
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
Q
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMAHO5 2169 printed Oct 16, 2024@17:42:30 Page 2
QAMAHO5 ;HISC/GJC-CHECKS SORT DATA FOR FALLOUT FILE ^QA(743.1 ;7/2/92 09:02
+1 ;;1.0;Clinical Monitoring System;;09/13/1993
+2 ;
SET ;BEGINNING/ENDING SORT VALUES FOR SET OF CODES DATA ELEMENTS
+1 SET QAMELEM=QAMDIEN
DO EN1^QAMUTL2
WRITE !!,"Enter the beginning and ending values for ",DIR("A"),".",!
+2 KILL DIR("A"),DIR("B")
SET DIR("A")="Start with: First// "
SET DIR(0)=$PIECE(DIR(0),U)_"A^"_$PIECE(DIR(0),U,2)
+3 DO ^DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET QAMOUT=1
QUIT
+4 IF X=""
SET DATA1=" "
SET DATA2="~"
GOTO SET1
+5 IF '$TEST
SET DATA1=Y(0)
+6 SET DIR("A")="End with: Last// "
+7 SET DATA1=Y
DO ^DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET QAMOUT=1
QUIT
+8 IF X=""
SET DATA2="~"
+9 IF '$TEST
SET DATA2=Y(0)
+10 IF (DATA2']DATA1)
IF (DATA1'=DATA2)
WRITE !!,*7,"The 'Start with' value must fall before the 'End with' value in the alphabet."
GOTO SET
SET1 DO LOOP
+1 QUIT
FREE ;BEGINNING/ENDING SORT VALUES FOR FREE TEXT DATA ELEMENTS
+1 SET QAMELEM=QAMDIEN
DO EN1^QAMUTL2
WRITE !!,"Enter the beginning and ending values for ",DIR("A"),".",!
+2 KILL DIR("A"),DIR("B")
SET DIR("A")="Start with: First// "
SET DIR(0)=$PIECE(DIR(0),U)_"A^"_$PIECE(DIR(0),U,2)
+3 DO ^DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET QAMOUT=1
QUIT
+4 IF X=""
SET DATA1=" "
SET DATA2="~"
GOTO FREE1
+5 IF '$TEST
SET DATA1=Y
+6 SET DIR("A")="End with: Last// "
+7 SET DATA1=Y
DO ^DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET QAMOUT=1
QUIT
+8 IF X=""
SET DATA2="~"
+9 IF '$TEST
SET DATA2=Y
+10 IF (DATA2']DATA1)
IF (DATA1'=DATA2)
WRITE !!,*7,"The 'Start with' value must fall before the 'End with' value in the alphabet."
GOTO FREE
FREE1 DO LOOP
+1 QUIT
EVENT ;BEGINNING/ENDING SORT VALUES FOR EVENT DATE
+1 WRITE !!,"Enter the beginning and ending values for EVENT DATE."
+2 DO ^QAQDATE
IF QAQQUIT
SET (QAMQUIT,QAMOUT)=1
QUIT
+3 FOR YZ=0:0
SET YZ=$ORDER(^QA(743.1,"AA",YZ))
if YZ'>0
QUIT
FOR LP=(QAQNBEG-.0000001):0
SET LP=$ORDER(^QA(743.1,"AA",YZ,LP))
if (LP'>0)!(LP>QAQNEND)
QUIT
DO EVENT1
+4 QUIT
EVENT1 ;
+1 SET Y=LP
XECUTE ^DD("DD")
+2 FOR QAMPT=0:0
SET QAMPT=$ORDER(^QA(743.1,"AA",YZ,LP,QAMPT))
if QAMPT'>0
QUIT
FOR QAMD0=0:0
SET QAMD0=$ORDER(^QA(743.1,"AA",YZ,LP,QAMPT,QAMD0))
if QAMD0'>0
QUIT
SET ^UTILITY($JOB,"QAM DATE",LP,QAMD0)=Y
+3 QUIT
LOOP ;
+1 SET LP0=""
FOR LP=0:0
SET LP0=$ORDER(^QA(743.1,"AD",QAMDIEN,LP0))
if LP0=""
QUIT
IF (LP0]DATA1)!(LP0=DATA1)
IF ((DATA2]LP0)!(DATA2=LP0))
DO LOOP1
+2 QUIT
LOOP1 FOR QAMD0=0:0
SET QAMD0=$ORDER(^QA(743.1,"AD",QAMDIEN,LP0,QAMD0))
if QAMD0'>0
QUIT
SET ^UTILITY($JOB,"QAM DLMNT",LP0,QAMD0)=LP0
+1 QUIT
