QAOEDT ;HISC/DAD-PATIENT SELECTOR ;2/4/93 08:03
;;3.0;Occurrence Screen;;09/14/1993
EN1 ; *** OPEN/CLOSED/BOTH RECORDS SCREEN
K QALIMIT D ENCHOS^QAOUTL0 G:QAOSQUIT EXIT
EN2 ; *** NO/USER SUPPLIED SCREEN
S QALIMIT=$S($G(QALIMIT)]"":QALIMIT,1:"I 1")
;
I $P($G(^QA(740,1,"OS")),"^",8)'>0 G SINGPAT
K DIR S DIR(0)="SO^1:Single/Multiple Records;2:Records by Date Range;"
S DIR("A")="Patient selection method",DIR("B")="Single/Multiple Records"
S DIR("?",1)="Enter 1 to choose one or more Occurrence Screen records."
S DIR("?")="Enter 2 to choose all Occurrence Screen records within a date range."
D ^DIR G EXIT:$D(DIRUT),DATRANG:Y=2
;
MULTPAT ; *** SELECT MULTIPLE PATIENTS
S QAQDIC="^QA(741,",QAQDIC(0)="AEMNQ",QAQDIC("A")="Select PATIENT: "
S QAQDIC("S")=QALIMIT,QAQUTIL="QAOEDT" D ^QAQSELCT G:QAQQUIT EXIT
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
. I $D(^QA(741,QAOSD0,0))#2 D PROGRAM(QAOSD0)
. Q
G EXIT
;
DATRANG ; *** SELECT PATIENTS BY DATE RANGE
D ^QAQDATE G:QAQQUIT EXIT S QAOSQUIT=0
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
. I $D(^QA(741,QAOSD0,0))#2 S Y=QAOSD0 X QALIMIT D:$T PROGRAM(QAOSD0)
. Q
G EXIT
;
SINGPAT ; *** SELECT PATIENTS ONE AT A TIME
F D Q:QAQQUIT
. K DIC S DIC="^QA(741,",DIC(0)="AEMNQZ",DIC("A")="Select PATIENT: "
. S DIC("S")=QALIMIT W ! D ^DIC S QAQQUIT=$S(Y'>0:1,1:0) Q:QAQQUIT
. S QAOSD0=+Y D PROGRAM(QAOSD0)
. Q
;
EXIT ; *** EXIT PATIENT SELECTOR ROUTINE
K ^UTILITY($J,"QAOEDT") D K^QAQDATE
Q
;
PROGRAM(QAOSD0) ; *** RUN THE OPTION (QAOSD0 = IEN IN FILE #741)
N QALIMIT,QAOSONE,QAQNBEG,QAQNEND
D @QAOSPROG
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOEDT 1912 printed Dec 13, 2024@02:21:04 Page 2
QAOEDT ;HISC/DAD-PATIENT SELECTOR ;2/4/93 08:03
+1 ;;3.0;Occurrence Screen;;09/14/1993
EN1 ; *** OPEN/CLOSED/BOTH RECORDS SCREEN
+1 KILL QALIMIT
DO ENCHOS^QAOUTL0
if QAOSQUIT
GOTO EXIT
EN2 ; *** NO/USER SUPPLIED SCREEN
+1 SET QALIMIT=$SELECT($GET(QALIMIT)]"":QALIMIT,1:"I 1")
+2 ;
+3 IF $PIECE($GET(^QA(740,1,"OS")),"^",8)'>0
GOTO SINGPAT
+4 KILL DIR
SET DIR(0)="SO^1:Single/Multiple Records;2:Records by Date Range;"
+5 SET DIR("A")="Patient selection method"
SET DIR("B")="Single/Multiple Records"
+6 SET DIR("?",1)="Enter 1 to choose one or more Occurrence Screen records."
+7 SET DIR("?")="Enter 2 to choose all Occurrence Screen records within a date range."
+8 DO ^DIR
if $DATA(DIRUT)
GOTO EXIT
if Y=2
GOTO DATRANG
+9 ;
MULTPAT ; *** SELECT MULTIPLE PATIENTS
+1 SET QAQDIC="^QA(741,"
SET QAQDIC(0)="AEMNQ"
SET QAQDIC("A")="Select PATIENT: "
+2 SET QAQDIC("S")=QALIMIT
SET QAQUTIL="QAOEDT"
DO ^QAQSELCT
if QAQQUIT
GOTO EXIT
+3 SET QAOSQUIT=0
SET QAOSONE=""
FOR
SET QAOSONE=$ORDER(^UTILITY($JOB,"QAOEDT",QAOSONE))
if QAOSONE=""!QAOSQUIT
QUIT
FOR QAOSD0=0:0
SET QAOSD0=$ORDER(^UTILITY($JOB,"QAOEDT",QAOSONE,QAOSD0))
if QAOSD0'>0!QAOSQUIT
QUIT
Begin DoDot:1
+4 IF $DATA(^QA(741,QAOSD0,0))#2
DO PROGRAM(QAOSD0)
+5 QUIT
End DoDot:1
+6 GOTO EXIT
+7 ;
DATRANG ; *** SELECT PATIENTS BY DATE RANGE
+1 DO ^QAQDATE
if QAQQUIT
GOTO EXIT
SET QAOSQUIT=0
+2 FOR QAOSONE=QAQNBEG-.00000001:0
SET QAOSONE=$ORDER(^QA(741,"C",QAOSONE))
if (QAOSONE'>0)!(QAOSONE>(QAQNEND+.24))!QAOSQUIT
QUIT
FOR QAOSD0=0:0
SET QAOSD0=$ORDER(^QA(741,"C",QAOSONE,QAOSD0))
if QAOSD0'>0!QAOSQUIT
QUIT
Begin DoDot:1
+3 IF $DATA(^QA(741,QAOSD0,0))#2
SET Y=QAOSD0
XECUTE QALIMIT
if $TEST
DO PROGRAM(QAOSD0)
+4 QUIT
End DoDot:1
+5 GOTO EXIT
+6 ;
SINGPAT ; *** SELECT PATIENTS ONE AT A TIME
+1 FOR
Begin DoDot:1
+2 KILL DIC
SET DIC="^QA(741,"
SET DIC(0)="AEMNQZ"
SET DIC("A")="Select PATIENT: "
+3 SET DIC("S")=QALIMIT
WRITE !
DO ^DIC
SET QAQQUIT=$SELECT(Y'>0:1,1:0)
if QAQQUIT
QUIT
+4 SET QAOSD0=+Y
DO PROGRAM(QAOSD0)
+5 QUIT
End DoDot:1
if QAQQUIT
QUIT
+6 ;
EXIT ; *** EXIT PATIENT SELECTOR ROUTINE
+1 KILL ^UTILITY($JOB,"QAOEDT")
DO K^QAQDATE
+2 QUIT
+3 ;
PROGRAM(QAOSD0) ; *** RUN THE OPTION (QAOSD0 = IEN IN FILE #741)
+1 NEW QALIMIT,QAOSONE,QAQNBEG,QAQNEND
+2 DO @QAOSPROG
+3 QUIT
