source: WorldVistAEHR/trunk/r/OCCURRENCE_SCREEN-QAO/QAOEDT.m@ 1211

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1QAOEDT ;HISC/DAD-PATIENT SELECTOR ;2/4/93 08:03
2 ;;3.0;Occurrence Screen;;09/14/1993
3EN1 ; *** OPEN/CLOSED/BOTH RECORDS SCREEN
4 K QALIMIT D ENCHOS^QAOUTL0 G:QAOSQUIT EXIT
5EN2 ; *** NO/USER SUPPLIED SCREEN
6 S QALIMIT=$S($G(QALIMIT)]"":QALIMIT,1:"I 1")
7 ;
8 I $P($G(^QA(740,1,"OS")),"^",8)'>0 G SINGPAT
9 K DIR S DIR(0)="SO^1:Single/Multiple Records;2:Records by Date Range;"
10 S DIR("A")="Patient selection method",DIR("B")="Single/Multiple Records"
11 S DIR("?",1)="Enter 1 to choose one or more Occurrence Screen records."
12 S DIR("?")="Enter 2 to choose all Occurrence Screen records within a date range."
13 D ^DIR G EXIT:$D(DIRUT),DATRANG:Y=2
14 ;
15MULTPAT ; *** SELECT MULTIPLE PATIENTS
16 S QAQDIC="^QA(741,",QAQDIC(0)="AEMNQ",QAQDIC("A")="Select PATIENT: "
17 S QAQDIC("S")=QALIMIT,QAQUTIL="QAOEDT" D ^QAQSELCT G:QAQQUIT EXIT
18 S QAOSQUIT=0,QAOSONE="" F S QAOSONE=$O(^UTILITY($J,"QAOEDT",QAOSONE)) Q:QAOSONE=""!QAOSQUIT F QAOSD0=0:0 S QAOSD0=$O(^UTILITY($J,"QAOEDT",QAOSONE,QAOSD0)) Q:QAOSD0'>0!QAOSQUIT D
19 . I $D(^QA(741,QAOSD0,0))#2 D PROGRAM(QAOSD0)
20 . Q
21 G EXIT
22 ;
23DATRANG ; *** SELECT PATIENTS BY DATE RANGE
24 D ^QAQDATE G:QAQQUIT EXIT S QAOSQUIT=0
25 F QAOSONE=QAQNBEG-.00000001:0 S QAOSONE=$O(^QA(741,"C",QAOSONE)) Q:(QAOSONE'>0)!(QAOSONE>(QAQNEND+.24))!QAOSQUIT F QAOSD0=0:0 S QAOSD0=$O(^QA(741,"C",QAOSONE,QAOSD0)) Q:QAOSD0'>0!QAOSQUIT D
26 . I $D(^QA(741,QAOSD0,0))#2 S Y=QAOSD0 X QALIMIT D:$T PROGRAM(QAOSD0)
27 . Q
28 G EXIT
29 ;
30SINGPAT ; *** SELECT PATIENTS ONE AT A TIME
31 F D Q:QAQQUIT
32 . K DIC S DIC="^QA(741,",DIC(0)="AEMNQZ",DIC("A")="Select PATIENT: "
33 . S DIC("S")=QALIMIT W ! D ^DIC S QAQQUIT=$S(Y'>0:1,1:0) Q:QAQQUIT
34 . S QAOSD0=+Y D PROGRAM(QAOSD0)
35 . Q
36 ;
37EXIT ; *** EXIT PATIENT SELECTOR ROUTINE
38 K ^UTILITY($J,"QAOEDT") D K^QAQDATE
39 Q
40 ;
41PROGRAM(QAOSD0) ; *** RUN THE OPTION (QAOSD0 = IEN IN FILE #741)
42 N QALIMIT,QAOSONE,QAQNBEG,QAQNEND
43 D @QAOSPROG
44 Q
Note: See TracBrowser for help on using the repository browser.