QAMAHO2 ;HISC/GJC-CHECKS SORT DATA FOR FALLOUT FILE ^QA(743.1 ;5/5/93 15:10
;;1.0;Clinical Monitoring System;;09/13/1993
;
PAT ;BEGINNING/ENDING SORT VALUES FOR PATIENT
W !!,"Enter the beginning and ending values for PATIENT NAME.",!
R !,"Start with: First// ",NAME1:DTIME
I '$T!(NAME1["^") S QAMOUT=1 Q
I NAME1="" S NAME1=" ",NAME2="~" G PAT3
I NAME1'?1U.A.",".A!($L(NAME1)>30) W !!,*7,"Names must start in uppercase, with or without a comma. Between 1-30 characters long." G PAT
PAT1 R !,"End with: Last// ",NAME2:DTIME
I '$T!(NAME2["^") S QAMOUT=1 Q
I NAME2="" S NAME2="~" G PAT2
I NAME2'?1U.A.",".A!($L(NAME2)>30) W !!,*7,"Names must start in uppercase, with or without a comma. Between 1-30 characters long." G PAT1
PAT2 I (NAME2']NAME1),(NAME1'=NAME2) W !!,*7,"The beginning name must fall before the ending name in the alphabet." G PAT
PAT3 F LP=0:0 S LP=$O(^QA(743.1,"B",LP)) Q:LP'>0 S PTNT=$P(^DPT(LP,0),U) I ((PTNT]NAME1)!(PTNT=NAME1)),((NAME2=PTNT)!(NAME2]PTNT)) F QAMD0=0:0 S QAMD0=$O(^QA(743.1,"B",LP,QAMD0)) Q:QAMD0'>0 S ^UTILITY($J,"QAM PAT",PTNT,QAMD0)=PTNT
Q
DLMNT ;SELECT DATA ELEMENT TO SORT BY
W ! K DIC,DLAYGO S DIC=743.4,DIC(0)="QEAMNZ",DIC("A")="Select DATA ELEMENT: " D ^DIC K DIC
I +Y=-1 S QAMOUT=1 Q
S QAMDATA=Y(0,0),QAMDIEN=+Y,QAMTYPE=$S($D(^QA(743.4,QAMDIEN,"DIR0"))#2:$E(^("DIR0")),1:"") S:QAMTYPE']"" QAMOUT=1 Q:QAMOUT
D DATE^QAMAHO4:QAMTYPE="D",FREE^QAMAHO5:QAMTYPE="F",NUM^QAMAHO4:QAMTYPE="N",POINT^QAMAHO4:QAMTYPE="P",SET^QAMAHO5:QAMTYPE="S"
Q
MON ;BEGINNING/ENDING SORT VALUES FOR MONITOR
W !!,"Enter the beginning and ending values for MONITOR CODE.",!
R !,"Start with: First// ",MON1:DTIME
I '$T!(MON1["^") S QAMOUT=1 Q
I MON1="" S MON1=" ",MON2="~" G MON5
I ((MON1'?1A.E)&(MON1'?1N.E))!($L(MON1)>30) W !!,*7,"Monitors must start in alphanumerics. Between 1-30 characters long." G MON
MON1 R !,"End with: Last// ",MON2:DTIME
I '$T!(MON2["^") S QAMOUT=1 Q
I MON2="" S MON2="~" G MON4
I ((MON2'?1N.E)&(MON2'?1A.E))!($L(MON2)>30) W !!,*7,"Monitors must start in alphanumerics. Between 1-30 characters long." G MON1
MON4 I (MON2']MON1),(MON1'=MON2) W !!,*7,"The beginning Monitor must fall before the ending Monitor." G MON
MON5 F LP=0:0 S LP=$O(^QA(743.1,"AA",LP)) Q:LP'>0 S MONI=$P($G(^QA(743,LP,0)),U) I MONI]"" I ((MONI]MON1)!(MON1=MONI)),((MON2]MONI)!(MON2=MONI)) D MON2
Q
MON2 ;
F QAMDT=0:0 S QAMDT=$O(^QA(743.1,"AA",LP,QAMDT)) Q:QAMDT'>0 F QAMPT=0:0 S QAMPT=$O(^QA(743.1,"AA",LP,QAMDT,QAMPT)) Q:QAMPT'>0 F QAMD0=0:0 S QAMD0=$O(^QA(743.1,"AA",LP,QAMDT,QAMPT,QAMD0)) Q:QAMD0'>0 S ^UTILITY($J,"QAM MON",MONI,QAMD0)=MONI
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMAHO2 2630 printed Dec 13, 2024@01:41:35 Page 2
QAMAHO2 ;HISC/GJC-CHECKS SORT DATA FOR FALLOUT FILE ^QA(743.1 ;5/5/93 15:10
+1 ;;1.0;Clinical Monitoring System;;09/13/1993
+2 ;
PAT ;BEGINNING/ENDING SORT VALUES FOR PATIENT
+1 WRITE !!,"Enter the beginning and ending values for PATIENT NAME.",!
+2 READ !,"Start with: First// ",NAME1:DTIME
+3 IF '$TEST!(NAME1["^")
SET QAMOUT=1
QUIT
+4 IF NAME1=""
SET NAME1=" "
SET NAME2="~"
GOTO PAT3
+5 IF NAME1'?1U.A.",".A!($LENGTH(NAME1)>30)
WRITE !!,*7,"Names must start in uppercase, with or without a comma. Between 1-30 characters long."
GOTO PAT
PAT1 READ !,"End with: Last// ",NAME2:DTIME
+1 IF '$TEST!(NAME2["^")
SET QAMOUT=1
QUIT
+2 IF NAME2=""
SET NAME2="~"
GOTO PAT2
+3 IF NAME2'?1U.A.",".A!($LENGTH(NAME2)>30)
WRITE !!,*7,"Names must start in uppercase, with or without a comma. Between 1-30 characters long."
GOTO PAT1
PAT2 IF (NAME2']NAME1)
IF (NAME1'=NAME2)
WRITE !!,*7,"The beginning name must fall before the ending name in the alphabet."
GOTO PAT
PAT3 FOR LP=0:0
SET LP=$ORDER(^QA(743.1,"B",LP))
if LP'>0
QUIT
SET PTNT=$PIECE(^DPT(LP,0),U)
IF ((PTNT]NAME1)!(PTNT=NAME1))
IF ((NAME2=PTNT)!(NAME2]PTNT))
FOR QAMD0=0:0
SET QAMD0=$ORDER(^QA(743.1,"B",LP,QAMD0))
if QAMD0'>0
QUIT
SET ^UTILITY($JOB,"QAM PAT",PTNT,QAMD0)=PTNT
+1 QUIT
DLMNT ;SELECT DATA ELEMENT TO SORT BY
+1 WRITE !
KILL DIC,DLAYGO
SET DIC=743.4
SET DIC(0)="QEAMNZ"
SET DIC("A")="Select DATA ELEMENT: "
DO ^DIC
KILL DIC
+2 IF +Y=-1
SET QAMOUT=1
QUIT
+3 SET QAMDATA=Y(0,0)
SET QAMDIEN=+Y
SET QAMTYPE=$SELECT($DATA(^QA(743.4,QAMDIEN,"DIR0"))#2:$EXTRACT(^("DIR0")),1:"")
if QAMTYPE']""
SET QAMOUT=1
if QAMOUT
QUIT
+4 if QAMTYPE="D"
DO DATE^QAMAHO4
if QAMTYPE="F"
DO FREE^QAMAHO5
if QAMTYPE="N"
DO NUM^QAMAHO4
if QAMTYPE="P"
DO POINT^QAMAHO4
if QAMTYPE="S"
DO SET^QAMAHO5
+5 QUIT
MON ;BEGINNING/ENDING SORT VALUES FOR MONITOR
+1 WRITE !!,"Enter the beginning and ending values for MONITOR CODE.",!
+2 READ !,"Start with: First// ",MON1:DTIME
+3 IF '$TEST!(MON1["^")
SET QAMOUT=1
QUIT
+4 IF MON1=""
SET MON1=" "
SET MON2="~"
GOTO MON5
+5 IF ((MON1'?1A.E)&(MON1'?1N.E))!($LENGTH(MON1)>30)
WRITE !!,*7,"Monitors must start in alphanumerics. Between 1-30 characters long."
GOTO MON
MON1 READ !,"End with: Last// ",MON2:DTIME
+1 IF '$TEST!(MON2["^")
SET QAMOUT=1
QUIT
+2 IF MON2=""
SET MON2="~"
GOTO MON4
+3 IF ((MON2'?1N.E)&(MON2'?1A.E))!($LENGTH(MON2)>30)
WRITE !!,*7,"Monitors must start in alphanumerics. Between 1-30 characters long."
GOTO MON1
MON4 IF (MON2']MON1)
IF (MON1'=MON2)
WRITE !!,*7,"The beginning Monitor must fall before the ending Monitor."
GOTO MON
MON5 FOR LP=0:0
SET LP=$ORDER(^QA(743.1,"AA",LP))
if LP'>0
QUIT
SET MONI=$PIECE($GET(^QA(743,LP,0)),U)
IF MONI]""
IF ((MONI]MON1)!(MON1=MONI))
IF ((MON2]MONI)!(MON2=MONI))
DO MON2
+1 QUIT
MON2 ;
+1 FOR QAMDT=0:0
SET QAMDT=$ORDER(^QA(743.1,"AA",LP,QAMDT))
if QAMDT'>0
QUIT
FOR QAMPT=0:0
SET QAMPT=$ORDER(^QA(743.1,"AA",LP,QAMDT,QAMPT))
if QAMPT'>0
QUIT
FOR QAMD0=0:0
SET QAMD0=$ORDER(^QA(743.1,"AA",LP,QAMDT,QAMPT,QAMD0))
if QAMD0'>0
QUIT
SET ^UTILITY($JOB,"QAM MON",MONI,QAMD0)=MONI
+2 QUIT
