source: WorldVistAEHR/trunk/r/CLINICAL_MONITORING_SYSTEM-QAM/QAMAHO2.m@ 1651

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

initial load of WorldVistAEHR

File size: 2.5 KB
RevLine 
[613]1QAMAHO2 ;HISC/GJC-CHECKS SORT DATA FOR FALLOUT FILE ^QA(743.1 ;5/5/93 15:10
2 ;;1.0;Clinical Monitoring System;;09/13/1993
3 ;
4PAT ;BEGINNING/ENDING SORT VALUES FOR PATIENT
5 W !!,"Enter the beginning and ending values for PATIENT NAME.",!
6 R !,"Start with: First// ",NAME1:DTIME
7 I '$T!(NAME1["^") S QAMOUT=1 Q
8 I NAME1="" S NAME1=" ",NAME2="~" G PAT3
9 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
10PAT1 R !,"End with: Last// ",NAME2:DTIME
11 I '$T!(NAME2["^") S QAMOUT=1 Q
12 I NAME2="" S NAME2="~" G PAT2
13 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
14PAT2 I (NAME2']NAME1),(NAME1'=NAME2) W !!,*7,"The beginning name must fall before the ending name in the alphabet." G PAT
15PAT3 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
16 Q
17DLMNT ;SELECT DATA ELEMENT TO SORT BY
18 W ! K DIC,DLAYGO S DIC=743.4,DIC(0)="QEAMNZ",DIC("A")="Select DATA ELEMENT: " D ^DIC K DIC
19 I +Y=-1 S QAMOUT=1 Q
20 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
21 D DATE^QAMAHO4:QAMTYPE="D",FREE^QAMAHO5:QAMTYPE="F",NUM^QAMAHO4:QAMTYPE="N",POINT^QAMAHO4:QAMTYPE="P",SET^QAMAHO5:QAMTYPE="S"
22 Q
23MON ;BEGINNING/ENDING SORT VALUES FOR MONITOR
24 W !!,"Enter the beginning and ending values for MONITOR CODE.",!
25 R !,"Start with: First// ",MON1:DTIME
26 I '$T!(MON1["^") S QAMOUT=1 Q
27 I MON1="" S MON1=" ",MON2="~" G MON5
28 I ((MON1'?1A.E)&(MON1'?1N.E))!($L(MON1)>30) W !!,*7,"Monitors must start in alphanumerics. Between 1-30 characters long." G MON
29MON1 R !,"End with: Last// ",MON2:DTIME
30 I '$T!(MON2["^") S QAMOUT=1 Q
31 I MON2="" S MON2="~" G MON4
32 I ((MON2'?1N.E)&(MON2'?1A.E))!($L(MON2)>30) W !!,*7,"Monitors must start in alphanumerics. Between 1-30 characters long." G MON1
33MON4 I (MON2']MON1),(MON1'=MON2) W !!,*7,"The beginning Monitor must fall before the ending Monitor." G MON
34MON5 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
35 Q
36MON2 ;
37 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
38 Q
Note: See TracBrowser for help on using the repository browser.