AQAOPR7.m

AQAOPR7 ; IHS/ORDC/LJF - REVIEWED OCCURRENCES REPORT ;

 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995

 ;

 ;This report prints occurrences listing all reviews and referrals.

 ;This rtn contains the user interface to select open and/or closed

 ;occ, type of report, users, teams, and date range.  The type of

 ;report questions calls extrinsic functions in ^AQAOPU*.

 ;

STATUS ; >>> ask if user wants to select closed or deleted occ

 W !!?2,"Which OCCURRENCES do you want to print?"

 K DIR S DIR(0)="LO^1:3^K:X#1 X",DIR("A",1)="  1.  OPEN"

 S DIR("A",2)="  2.  CLOSED",DIR("A",3)="  3.  DELETED",DIR("A",4)=" "

 S DIR("A")="Select ONE OR MORE, by number separated by commas"

 D ^DIR G END:$D(DIRUT) S AQAOSTAT=Y

 ;

 ;

TYPE ; >> ask user what type of report to print

 K ^TMP("AQAOPR7",$J) W !! K DIR

 S DIR(0)="SO^1:ONE INDICATOR;2:BY KEY FUNCTION;3:FACILITY REPORT"

 S DIR("A")="Select TYPE OF REPORT to print"

 S DIR("?")="Choose ONE from the list by number"

 D ^DIR G END:$D(DIRUT),TYPE:Y=-1

 S X="AQAOPR7"

 S AQAOTP=$S(Y=1:$$IND^AQAOPU(X),Y=2:$$KF^AQAOPU(X),1:$$FACR^AQAOPU1(X))

 K ^TMP("AQAOPR7",$J,2) ;ind you don't have access to

 G TYPE:AQAOTP=U

 ;

 ;

USERS ; >> ask user to screen by user

 W !! K DIR S DIR(0)="YO",DIR("B")="NO"

 S DIR("A")="Do you wish to limit the report by USER" D ^DIR

 G STATUS:$D(DIRUT) S AQAOO("USR",0)="" ;all users

 I Y=1 F  Q:$D(DIRUT)  D  ;ask for users to include

 .W !! K DIR S DIR(0)="PO^200:EMQZ",DIR("A")="Select USER Name"

 .D ^DIR Q:$D(DIRUT) 

 .I Y>0 D  ;set up array for variable pointers to va200 or qi user file

 ..S AQAOO("USR",+Y_";VA(200,")=$P(Y,U,2)

 ..S AQAOO("USR",+Y_";AQAO(9,")=$P(Y,U,2)

 ;

 ;

TEAMS ; >> ask user to screen by teams

 W !! K DIR S DIR(0)="YO",DIR("B")="NO"

 S DIR("A")="Do you wish to limit the report by QI TEAM" D ^DIR

 G USERS:$D(DIRUT) S AQAOO("TEAM",0)="" ;all qi teams

 I Y=1 F  Q:$D(DIRUT)  D  ;ask for users to include

 .W !! K DIR S DIR(0)="PO^9002169.1:EMQZ" D ^DIR Q:$D(DIRUT) 

 .I Y>0 S AQAOO("TEAM",+Y_";AQAO1(1,")=$P(Y,U,2)

 ;

 ;

DATES ; >> ask user to choose date range

 S AQAOBD=$$BDATE^AQAOLKP G END:AQAOBD=U,TEAMS:AQAOBD=""

 S AQAOED=$$EDATE^AQAOLKP G END:AQAOED=U,DATES:AQAOED=""

 ;

 ;

DEV ; >>> get print device

 I $P(AQAOUA("USER"),U,7)=1 D EXPORT^AQAOUTIL G DATES:Y=U

 W !! S %ZIS="QP" D ^%ZIS G END:POP

 I '$D(IO("Q")) U IO G ^AQAOPR71

 K IO("Q") S ZTRTN="^AQAOPR71",ZTDESC="REVIEWED OCC RPRT"

 F I="AQAOTP","AQAOBD","AQAOED","AQAOO(","AQAOSTAT" S ZTSAVE(I)=""

 S ZTSAVE("^TMP(""AQAOPR7"",$J,")=""

 S:$D(AQAODLM) ZTSAVE("AQAODLM")=""

 D ^%ZTLOAD K ZTSK D ^%ZISC D KILL^AQAOUTIL Q

 ;

END ; >>> eoj

 D HOME^%ZIS D KILL^AQAOUTIL K ^TMP("AQAOPR7",$J) Q

AQAOPR7   ; IHS/ORDC/LJF - REVIEWED OCCURRENCES REPORT ;

 +1       ;;1.01;QAI MANAGEMENT;;OCT 05, 1995

 +2       ;

 +3       ;This report prints occurrences listing all reviews and referrals.

 +4       ;This rtn contains the user interface to select open and/or closed

 +5       ;occ, type of report, users, teams, and date range.  The type of

 +6       ;report questions calls extrinsic functions in ^AQAOPU*.

 +7       ;

STATUS    ; >>> ask if user wants to select closed or deleted occ

 +1        WRITE !!?2,"Which OCCURRENCES do you want to print?"

 +2        KILL DIR

           SET DIR(0)="LO^1:3^K:X#1 X"

           SET DIR("A",1)="  1.  OPEN"

 +3        SET DIR("A",2)="  2.  CLOSED"

           SET DIR("A",3)="  3.  DELETED"

           SET DIR("A",4)=" "

 +4        SET DIR("A")="Select ONE OR MORE, by number separated by commas"

 +5        DO ^DIR

           IF $DATA(DIRUT)

               GOTO END

           SET AQAOSTAT=Y

 +6       ;

 +7       ;

TYPE      ; >> ask user what type of report to print

 +1        KILL ^TMP("AQAOPR7",$JOB)

           WRITE !!

           KILL DIR

 +2        SET DIR(0)="SO^1:ONE INDICATOR;2:BY KEY FUNCTION;3:FACILITY REPORT"

 +3        SET DIR("A")="Select TYPE OF REPORT to print"

 +4        SET DIR("?")="Choose ONE from the list by number"

 +5        DO ^DIR

           IF $DATA(DIRUT)

               GOTO END

           IF Y=-1

               GOTO TYPE

 +6        SET X="AQAOPR7"

 +7        SET AQAOTP=$SELECT(Y=1:$$IND^AQAOPU(X),Y=2:$$KF^AQAOPU(X),1:$$FACR^AQAOPU1(X))

 +8       ;ind you don't have access to

           KILL ^TMP("AQAOPR7",$JOB,2)

 +9        IF AQAOTP=U

               GOTO TYPE

 +10      ;

 +11      ;

USERS     ; >> ask user to screen by user

 +1        WRITE !!

           KILL DIR

           SET DIR(0)="YO"

           SET DIR("B")="NO"

 +2        SET DIR("A")="Do you wish to limit the report by USER"

           DO ^DIR

 +3       ;all users

           IF $DATA(DIRUT)

               GOTO STATUS

           SET AQAOO("USR",0)=""

 +4       ;ask for users to include

           IF Y=1

               FOR 

                   IF $DATA(DIRUT)

                       QUIT 

                   Begin DoDot:1

 +5                    WRITE !!

                       KILL DIR

                       SET DIR(0)="PO^200:EMQZ"

                       SET DIR("A")="Select USER Name"

 +6                    DO ^DIR

                       IF $DATA(DIRUT)

                           QUIT 

 +7       ;set up array for variable pointers to va200 or qi user file

                       IF Y>0

                           Begin DoDot:2

 +8                            SET AQAOO("USR",+Y_";VA(200,")=$PIECE(Y,U,2)

 +9                            SET AQAOO("USR",+Y_";AQAO(9,")=$PIECE(Y,U,2)

                           End DoDot:2

                   End DoDot:1

 +10      ;

 +11      ;

TEAMS     ; >> ask user to screen by teams

 +1        WRITE !!

           KILL DIR

           SET DIR(0)="YO"

           SET DIR("B")="NO"

 +2        SET DIR("A")="Do you wish to limit the report by QI TEAM"

           DO ^DIR

 +3       ;all qi teams

           IF $DATA(DIRUT)

               GOTO USERS

           SET AQAOO("TEAM",0)=""

 +4       ;ask for users to include

           IF Y=1

               FOR 

                   IF $DATA(DIRUT)

                       QUIT 

                   Begin DoDot:1

 +5                    WRITE !!

                       KILL DIR

                       SET DIR(0)="PO^9002169.1:EMQZ"

                       DO ^DIR

                       IF $DATA(DIRUT)

                           QUIT 

 +6                    IF Y>0

                           SET AQAOO("TEAM",+Y_";AQAO1(1,")=$PIECE(Y,U,2)

                   End DoDot:1

 +7       ;

 +8       ;

DATES     ; >> ask user to choose date range

 +1        SET AQAOBD=$$BDATE^AQAOLKP

           IF AQAOBD=U

               GOTO END

           IF AQAOBD=""

               GOTO TEAMS

 +2        SET AQAOED=$$EDATE^AQAOLKP

           IF AQAOED=U

               GOTO END

           IF AQAOED=""

               GOTO DATES

 +3       ;

 +4       ;

DEV       ; >>> get print device

 +1        IF $PIECE(AQAOUA("USER"),U,7)=1

               DO EXPORT^AQAOUTIL

               IF Y=U

                   GOTO DATES

 +2        WRITE !!

           SET %ZIS="QP"

           DO ^%ZIS

           IF POP

               GOTO END

 +3        IF '$DATA(IO("Q"))

               USE IO

               GOTO ^AQAOPR71

 +4        KILL IO("Q")

           SET ZTRTN="^AQAOPR71"

           SET ZTDESC="REVIEWED OCC RPRT"

 +5        FOR I="AQAOTP","AQAOBD","AQAOED","AQAOO(","AQAOSTAT"

               SET ZTSAVE(I)=""

 +6        SET ZTSAVE("^TMP(""AQAOPR7"",$J,")=""

 +7        IF $DATA(AQAODLM)

               SET ZTSAVE("AQAODLM")=""

 +8        DO ^%ZTLOAD

           KILL ZTSK

           DO ^%ZISC

           DO KILL^AQAOUTIL

           QUIT 

 +9       ;

END       ; >>> eoj

 +1        DO HOME^%ZIS

           DO KILL^AQAOUTIL

           KILL ^TMP("AQAOPR7",$JOB)

           QUIT