1 | QAOEDT ;HISC/DAD-PATIENT SELECTOR ;2/4/93 08:03
|
---|
2 | ;;3.0;Occurrence Screen;;09/14/1993
|
---|
3 | EN1 ; *** OPEN/CLOSED/BOTH RECORDS SCREEN
|
---|
4 | K QALIMIT D ENCHOS^QAOUTL0 G:QAOSQUIT EXIT
|
---|
5 | EN2 ; *** 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 | ;
|
---|
15 | MULTPAT ; *** 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 | ;
|
---|
23 | DATRANG ; *** 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 | ;
|
---|
30 | SINGPAT ; *** 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 | ;
|
---|
37 | EXIT ; *** EXIT PATIENT SELECTOR ROUTINE
|
---|
38 | K ^UTILITY($J,"QAOEDT") D K^QAQDATE
|
---|
39 | Q
|
---|
40 | ;
|
---|
41 | PROGRAM(QAOSD0) ; *** RUN THE OPTION (QAOSD0 = IEN IN FILE #741)
|
---|
42 | N QALIMIT,QAOSONE,QAQNBEG,QAQNEND
|
---|
43 | D @QAOSPROG
|
---|
44 | Q
|
---|