Routine: BOPEXCP

BOPEXCP ;IHS/ILC/DUG -  Exception error report;06-Apr-2005 13:41;SM

 ;;1.0;AUTOMATED DISPENSING INTERFACE;;Jul 26, 2005

FIND ;find all the error exceptions and put in array

 N DIR,X,Y,X1,X2,BOPNAME,BOPDT,BOPDRUG,BOPDRGNM,BOPERR,BOPDTTM,CNT,A,BOPDFN,BOPUSER

 S DIR("A")="Enter the date to begin the Exception Report"

 S DIR("B")="T-1",DIR(0)="D" D ^DIR

 Q:Y'>0

 S (BOPNAME,BOPDT,BOPDRUG,BOPDRGNM,BOPERR,BOPUSER)="",CNT=1

 S BOPDTTM=Y S X1=Y,X2=-1 D C^%DTC S BOPDTTM=X

 F  S BOPDTTM=$O(^BOP(90355.4,"B",BOPDTTM)) Q:'BOPDTTM  D

 . S A=$O(^BOP(90355.4,"B",BOPDTTM,0))

 . S BOPDRUG=$P(^BOP(90355.4,A,0),U,8) I BOPDRUG["-" S BOPDRUG=$P(BOPDRUG,"-",2)

 . I '$D(^PSDRUG(BOPDRUG,0)) S BOPERR="Bad Drug" S BOPDRGNM=$P(^BOP(90355.4,A,0),U,12) S BOPDFN=$P(^BOP(90355.4,A,0),U,5)

 . S BOPNAME=$S(BOPDFN'="":$P($G(^DPT(BOPDFN,0)),U),1:"Invalid patient")

 . S BOPDFN=$P(^BOP(90355.4,A,0),U,5)

 . I BOPDFN="" S BOPERR="Bad Patient ID" S BOPDRGNM=$P(^BOP(90355.4,A,0),U,12)

 . I BOPDFN I '$D(^DPT(BOPDFN,0)) S BOPERR="Bad Patient ID" S BOPDRGNM=$P(^BOP(90355.4,A,0),U,12)

 . S BOPUSER="" S BOPUSER=$P(^BOP(90355.4,A,0),U,14)

 . S BOPTMP(CNT)=BOPERR_" "_$S(BOPERR["Drug":$G(BOPDRUG),1:$G(BOPDFN))_"^"_BOPDRGNM_"^"_BOPDTTM_"^"_"Pt: "_BOPNAME_"^"_"User: "_BOPUSER,CNT=CNT+1

 D ASKPR

 QUIT

HEADER ;

 W @IOF,"TYPE OF ERROR ^ DRUG NAME ^ DATE/TIME ^ PATIENT NAME ^ USER NAME",!! Q

ASKPR ;

 S %ZIS="Q" D ^%ZIS I POP K ZTRTN,ZTDESC,POP D ^%ZISC QUIT

 I $D(IO("Q")) D  D ^%ZISC QUIT

 . S ZTRTN="PRINT^VEFCDSP1",ZTDESC="EXCEPTION REPORT"

 . D ^%ZTLOAD W:$D(ZTSK) !,"Report Queued to Print!!",! K ZTSK,IO("Q")

PRINT ;

 N CNT,ANS,STOP S STOP="" D HEADER

 S CNT=0 F  S CNT=$O(BOPTMP(CNT)) Q:'CNT  W !,BOPTMP(CNT) D  Q:STOP

 . I IOST["P" Q

 . I CNT#20=0 S DIR("A")="Enter '^' to quit, <return> to continue",DIR(0)="FO" D  Q:STOP

 . . D ^DIR K DIR I $D(DIRUT) S STOP=1 Q    ;DUGIHS 9/27/04 invoke DIR call

 . . D HEADER

 QUIT

EOR ;BOPEXCP;Exception error report

BOPEXCP   ;IHS/ILC/DUG -  Exception error report;06-Apr-2005 13:41;SM

 +1       ;;1.0;AUTOMATED DISPENSING INTERFACE;;Jul 26, 2005

 +2       ;

FIND      ;find all the error exceptions and put in array

 +1        NEW DIR,X,Y,X1,X2,BOPNAME,BOPDT,BOPDRUG,BOPDRGNM,BOPERR,BOPDTTM,CNT,A,BOPDFN,BOPUSER

 +2        SET DIR("A")="Enter the date to begin the Exception Report"

 +3        SET DIR("B")="T-1"

           SET DIR(0)="D"

           DO ^DIR

 +4        IF Y'>0

               QUIT

 +5        SET (BOPNAME,BOPDT,BOPDRUG,BOPDRGNM,BOPERR,BOPUSER)=""

           SET CNT=1

 +6        SET BOPDTTM=Y

           SET X1=Y

           SET X2=-1

           DO C^%DTC

           SET BOPDTTM=X

 +7        FOR

               SET BOPDTTM=$ORDER(^BOP(90355.4,"B",BOPDTTM))

               IF 'BOPDTTM

                   QUIT

               Begin DoDot:1

 +8                SET A=$ORDER(^BOP(90355.4,"B",BOPDTTM,0))

 +9                SET BOPDRUG=$PIECE(^BOP(90355.4,A,0),U,8)

                   IF BOPDRUG["-"

                       SET BOPDRUG=$PIECE(BOPDRUG,"-",2)

 +10               IF '$DATA(^PSDRUG(BOPDRUG,0))

                       SET BOPERR="Bad Drug"

                       SET BOPDRGNM=$PIECE(^BOP(90355.4,A,0),U,12)

                       SET BOPDFN=$PIECE(^BOP(90355.4,A,0),U,5)

 +11               SET BOPNAME=$SELECT(BOPDFN'="":$PIECE($GET(^DPT(BOPDFN,0)),U),1:"Invalid patient")

 +12               SET BOPDFN=$PIECE(^BOP(90355.4,A,0),U,5)

 +13               IF BOPDFN=""

                       SET BOPERR="Bad Patient ID"

                       SET BOPDRGNM=$PIECE(^BOP(90355.4,A,0),U,12)

 +14               IF BOPDFN

                       IF '$DATA(^DPT(BOPDFN,0))

                           SET BOPERR="Bad Patient ID"

                           SET BOPDRGNM=$PIECE(^BOP(90355.4,A,0),U,12)

 +15               SET BOPUSER=""

                   SET BOPUSER=$PIECE(^BOP(90355.4,A,0),U,14)

 +16               SET BOPTMP(CNT)=BOPERR_" "_$SELECT(BOPERR["Drug":$GET(BOPDRUG),1:$GET(BOPDFN))_"^"_BOPDRGNM_"^"_BOPDTTM_"^"_"Pt: "_BOPNAME_"^"_"User: "_BOPUSER

                   SET CNT=CNT+1

               End DoDot:1

 +17       DO ASKPR

 +18       QUIT

 +19      ;

HEADER    ;

 +1        WRITE @IOF,"TYPE OF ERROR ^ DRUG NAME ^ DATE/TIME ^ PATIENT NAME ^ USER NAME",!!

           QUIT

 +2       ;

ASKPR     ;

 +1        SET %ZIS="Q"

           DO ^%ZIS

           IF POP

               KILL ZTRTN,ZTDESC,POP

               DO ^%ZISC

               QUIT

 +2        IF $DATA(IO("Q"))

               Begin DoDot:1

 +3                SET ZTRTN="PRINT^VEFCDSP1"

                   SET ZTDESC="EXCEPTION REPORT"

 +4                DO ^%ZTLOAD

                   IF $DATA(ZTSK)

                       WRITE !,"Report Queued to Print!!",!

                   KILL ZTSK,IO("Q")

               End DoDot:1

               DO ^%ZISC

               QUIT

PRINT     ;

 +1        NEW CNT,ANS,STOP

           SET STOP=""

           DO HEADER

 +2        SET CNT=0

FOR

               SET CNT=$ORDER(BOPTMP(CNT))

               IF 'CNT

                   QUIT

               WRITE !,BOPTMP(CNT)

               Begin DoDot:1

 +3                IF IOST["P"

                       QUIT

 +4                IF CNT#20=0

                       SET DIR("A")="Enter '^' to quit, <return> to continue"

                       SET DIR(0)="FO"

                       Begin DoDot:2

 +5       ;DUGIHS 9/27/04 invoke DIR call

                           DO ^DIR

                           KILL DIR

                           IF $DATA(DIRUT)

                               SET STOP=1

                               QUIT

 +6                        DO HEADER

                       End DoDot:2

                       IF STOP

                           QUIT

               End DoDot:1

               IF STOP

                   QUIT

 +7        QUIT

 +8       ;

EOR       ;BOPEXCP;Exception error report

BOPEXCP.m