- 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 Apr 23, 2025@17:56:06 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
