AQAQMCQ.m

AQAQMCQ ;IHS/ANMC/LJF - QUEUE MISSING CREDENTIALS REPORT; [ 05/27/92  11:24 AM ]

 ;;2.2;STAFF CREDENTIALS;;01 OCT 1992

 ;

 W @IOF,!!!?20,"PRINT MISSING CREDENTIALS REPORT",!!

 ;

 ;***> select type of report

TYPE K DIR S DIR("A",1)="Select Sorting Order for Report:"

 S DIR("A",2)="     1.  ALPHABETICALLY (By Provider Name)"

 S DIR("A",3)="     2.  By PROVIDER CLASS"

 S DIR("A",4)="     3.  By STAFF CATEGORY"

SELECT S DIR("A")="Select (1, 2, or 3):  ",DIR(0)="NAO^1:3" D ^DIR

 G END:$D(DTOUT),END:X="",END:$D(DUOUT),TYPE:Y=-1 S AQAQTYP=Y

 I AQAQTYP=1 S AQAQSRT="" G DEV

 ;

ALL ;***> choose one or all classes or categories

 K DIR S DIR(0)="Y"

 S DIR("A")=$S(AQAQTYP=2:"Print for All Classes",1:"Print for All Categories")

 S DIR("B")="NO" D ^DIR I Y=1 S AQAQSRT="ALL" G DEV  ;all wards or serv

 I $D(DIRUT) G END  ;check for timeout,"^", or null

 ;

ONE ;***> choose which class or category to print

 I AQAQTYP=2 D  G END:'$D(AQAQSRT) G DEV

 .K DIR,AQAQSRT S DIR(0)="PO^7:EMQZ" D ^DIR

 .Q:$D(DTOUT)  Q:X=""  Q:$D(DUOUT)  Q:Y=-1

 .I $D(^DIC(42,+Y,"I")),$P(^("I"),U)="I" W ?40,"** INACTIVE WARD **" Q

 .S AQAQSRT=Y

 E  D  G END:'$D(AQAQSRT)

 .K DIR,AQAQSRT S DIR(0)="9002165,.02" D ^DIR

 .Q:$D(DTOUT)  Q:X=""  Q:$D(DUOUT)  Q:Y=-1

 .S AQAQSRT=Y

 ;

 ;***> select print device

DEV S %ZIS="PQ" D ^%ZIS G END:POP,QUE:$D(IO("Q")) U IO G ^AQAQMCC

QUE K IO("Q") S ZTRTN="^AQAQMCC" S ZTDESC="MISSING CREDENTIALS"

 F AQAQI="AQAQTYP","AQAQSRT" S ZTSAVE(AQAQI)=""

 D ^%ZTLOAD D ^%ZISC K ZTSK

 ;

END K Y,AQAQTYP,AQAQSRT,DIR,AQAQI D HOME^%ZIS Q

AQAQMCQ   ;IHS/ANMC/LJF - QUEUE MISSING CREDENTIALS REPORT; [ 05/27/92  11:24 AM ]

 +1       ;;2.2;STAFF CREDENTIALS;;01 OCT 1992

 +2       ;

 +3        WRITE @IOF,!!!?20,"PRINT MISSING CREDENTIALS REPORT",!!

 +4       ;

 +5       ;***> select type of report

TYPE       KILL DIR

           SET DIR("A",1)="Select Sorting Order for Report:"

 +1        SET DIR("A",2)="     1.  ALPHABETICALLY (By Provider Name)"

 +2        SET DIR("A",3)="     2.  By PROVIDER CLASS"

 +3        SET DIR("A",4)="     3.  By STAFF CATEGORY"

SELECT     SET DIR("A")="Select (1, 2, or 3):  "

           SET DIR(0)="NAO^1:3"

           DO ^DIR

 +1        IF $DATA(DTOUT)

               GOTO END

           IF X=""

               GOTO END

           IF $DATA(DUOUT)

               GOTO END

           IF Y=-1

               GOTO TYPE

           SET AQAQTYP=Y

 +2        IF AQAQTYP=1

               SET AQAQSRT=""

               GOTO DEV

 +3       ;

ALL       ;***> choose one or all classes or categories

 +1        KILL DIR

           SET DIR(0)="Y"

 +2        SET DIR("A")=$SELECT(AQAQTYP=2:"Print for All Classes",1:"Print for All Categories")

 +3       ;all wards or serv

           SET DIR("B")="NO"

           DO ^DIR

           IF Y=1

               SET AQAQSRT="ALL"

               GOTO DEV

 +4       ;check for timeout,"^", or null

           IF $DATA(DIRUT)

               GOTO END

 +5       ;

ONE       ;***> choose which class or category to print

 +1        IF AQAQTYP=2

               Begin DoDot:1

 +2                KILL DIR,AQAQSRT

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

                   DO ^DIR

 +3                IF $DATA(DTOUT)

                       QUIT 

                   IF X=""

                       QUIT 

                   IF $DATA(DUOUT)

                       QUIT 

                   IF Y=-1

                       QUIT 

 +4                IF $DATA(^DIC(42,+Y,"I"))

                       IF $PIECE(^("I"),U)="I"

                           WRITE ?40,"** INACTIVE WARD **"

                           QUIT 

 +5                SET AQAQSRT=Y

               End DoDot:1

               IF '$DATA(AQAQSRT)

                   GOTO END

               GOTO DEV

 +6       IF '$TEST

               Begin DoDot:1

 +7                KILL DIR,AQAQSRT

                   SET DIR(0)="9002165,.02"

                   DO ^DIR

 +8                IF $DATA(DTOUT)

                       QUIT 

                   IF X=""

                       QUIT 

                   IF $DATA(DUOUT)

                       QUIT 

                   IF Y=-1

                       QUIT 

 +9                SET AQAQSRT=Y

               End DoDot:1

               IF '$DATA(AQAQSRT)

                   GOTO END

 +10      ;

 +11      ;***> select print device

DEV        SET %ZIS="PQ"

           DO ^%ZIS

           IF POP

               GOTO END

           IF $DATA(IO("Q"))

               GOTO QUE

           USE IO

           GOTO ^AQAQMCC

QUE        KILL IO("Q")

           SET ZTRTN="^AQAQMCC"

           SET ZTDESC="MISSING CREDENTIALS"

 +1        FOR AQAQI="AQAQTYP","AQAQSRT"

               SET ZTSAVE(AQAQI)=""

 +2        DO ^%ZTLOAD

           DO ^%ZISC

           KILL ZTSK

 +3       ;

END        KILL Y,AQAQTYP,AQAQSRT,DIR,AQAQI

           DO HOME^%ZIS

           QUIT