- 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 Jan 18, 2025@03:22:15 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