PSALND.m

PSALND ;BIR/LTL-Report Potential NDC Matches ;7/23/97

 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**15,38**; 10/24/97

 ;

 ;References to ^PSDRUG( are covered by IA #2095

 ;References to ^PRC( are covered by IA #214

 ;References to ^PSDRUG("AB" are covered by IA #2095

 D DT^DICRW

DEV ;asks device and queueing info

 K IO("Q") N %ZIS,DIR,DTOUT,DUOUT,IOP,POP,PSAOUT S %ZIS="Q" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!" S PSAOUT=1 G QUIT

 I $D(IO("Q")) N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK S ZTRTN="START^PSALND",ZTDESC="Unlinked DRUG/ITEM FILE matches by NDC" D ^%ZTLOAD,HOME^%ZIS S PSAOUT=1 G QUIT

START ;compiles and prints data for report

 ;PSA*3.0*38;IOFO BAY PINES;VGF - set var PSAIA if item in item master file is inactive, no longer checking Drug File IFCAP cross reference

 N DIRUT,PSAPG,POP,PSA,PSAB,PSAD,PSADD,PSAIT,PSALN,PSARPDT,X,Y,PSAIA S (PSA,PSAD,PSAPG,PSAOUT)=0,Y=DT D DD^%DT S PSARPDT=Y D HEADER

LOOP F  S PSAD=$O(^PSDRUG(PSAD)) G:'PSAD QUIT D:$Y+7>IOSL HEADER G:PSAOUT QUIT W:'(PSAD#100) "." I $P($G(^PSDRUG(PSAD,2)),U,4)]"" S PSAD(1)=$P($G(^(2)),U,4) D:'$D(^PSDRUG(PSAD,"I"))  G:$G(PSAOUT) QUIT

 .S PSAIT=$$ITEM^PSAUTL(PSAD(1))

 .Q:'PSAIT

 .S PSAIA=0

 .I $D(^PRC(441,PSAIT,3)),$P(^(3),U)=1 S PSAIA=1

 .Q:PSAIA

 .I $D(^PRC(441,PSAIT,0)) Q:$O(^PSDRUG("AB",PSAIT,0))

 .W !!,"NDC:  "_$P(^PSDRUG(PSAD,2),U,4),?40,"Item Number:  "_$P(^PRC(441,PSAIT,0),U),!

 .W !,$E($P(^PSDRUG(PSAD,0),U),1,39)

 .I $L($G(^PRC(441,+PSAIT,1,1,0)))<40,'$O(^PRC(441,+PSAIT,1,1)) W ?40,$G(^PRC(441,+PSAIT,1,1,0)) Q

 .K ^UTILITY($J,"W") S DIWL=40,DIWR=80,DIWF="W"

 .F  S PSA=$O(^PRC(441,+PSAIT,1,+PSA)) Q:'PSA  S X=$G(^PRC(441,+PSAIT,1,+PSA,0)) D:$Y+3>IOSL HEADER Q:$G(PSAOUT)  D ^DIWP D ^DIWW

 .S PSA=0

QUIT I $E(IOST)'="C" W @IOF

 I $E(IOST,1,2)="C-",'PSAOUT W !! S DIR(0)="EA",DIR("A")="END OF REPORT!  Press <RET> to return to the menu." D ^DIR

 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q")

 Q

HEADER ;prints header info

 I $E(IOST,1,2)'="P-",PSAPG S DIR(0)="E" D ^DIR K DIR I 'Y S PSAOUT=1 Q

 I $$S^%ZTLOAD W !!,"Task #",$G(ZTSK),", ",$G(ZTDESC)," was stopped by ",$P($G(^VA(200,+$G(DUZ),0)),U),"." S PSAOUT=1 Q

 W:$Y @IOF S $P(PSALN,"*",81)="",PSAPG=PSAPG+1 W !?2,"Unlinked DRUG/ITEM MASTER file entries by common NDC",?55,PSARPDT,?70,"PAGE: "_PSAPG,!,PSALN,!,"DRUG file",?40,"ITEM MASTER file"

 W:$G(PSA)&($O(^PRC(441,+$G(PSAIT),1,+$G(PSA)))) !,$P(^PSDRUG(PSAD,0),U)," continued"

 Q

PSALND    ;BIR/LTL-Report Potential NDC Matches ;7/23/97

 +1       ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**15,38**; 10/24/97

 +2       ;

 +3       ;References to ^PSDRUG( are covered by IA #2095

 +4       ;References to ^PRC( are covered by IA #214

 +5       ;References to ^PSDRUG("AB" are covered by IA #2095

 +6        DO DT^DICRW

DEV       ;asks device and queueing info

 +1        KILL IO("Q")

           NEW %ZIS,DIR,DTOUT,DUOUT,IOP,POP,PSAOUT

           SET %ZIS="Q"

           DO ^%ZIS

           IF POP

               WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!"

               SET PSAOUT=1

               GOTO QUIT

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

               NEW ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK

               SET ZTRTN="START^PSALND"

               SET ZTDESC="Unlinked DRUG/ITEM FILE matches by NDC"

               DO ^%ZTLOAD

               DO HOME^%ZIS

               SET PSAOUT=1

               GOTO QUIT

START     ;compiles and prints data for report

 +1       ;PSA*3.0*38;IOFO BAY PINES;VGF - set var PSAIA if item in item master file is inactive, no longer checking Drug File IFCAP cross reference

 +2        NEW DIRUT,PSAPG,POP,PSA,PSAB,PSAD,PSADD,PSAIT,PSALN,PSARPDT,X,Y,PSAIA

           SET (PSA,PSAD,PSAPG,PSAOUT)=0

           SET Y=DT

           DO DD^%DT

           SET PSARPDT=Y

           DO HEADER

LOOP       FOR 

               SET PSAD=$ORDER(^PSDRUG(PSAD))

               IF 'PSAD

                   GOTO QUIT

               IF $Y+7>IOSL

                   DO HEADER

               IF PSAOUT

                   GOTO QUIT

               IF '(PSAD#100)

                   WRITE "."

               IF $PIECE($GET(^PSDRUG(PSAD,2)),U,4)]""

                   SET PSAD(1)=$PIECE($GET(^(2)),U,4)

                   IF '$DATA(^PSDRUG(PSAD,"I"))

                       Begin DoDot:1

 +1                        SET PSAIT=$$ITEM^PSAUTL(PSAD(1))

 +2                        IF 'PSAIT

                               QUIT 

 +3                        SET PSAIA=0

 +4                        IF $DATA(^PRC(441,PSAIT,3))

                               IF $PIECE(^(3),U)=1

                                   SET PSAIA=1

 +5                        IF PSAIA

                               QUIT 

 +6                        IF $DATA(^PRC(441,PSAIT,0))

                               IF $ORDER(^PSDRUG("AB",PSAIT,0))

                                   QUIT 

 +7                        WRITE !!,"NDC:  "_$PIECE(^PSDRUG(PSAD,2),U,4),?40,"Item Number:  "_$PIECE(^PRC(441,PSAIT,0),U),!

 +8                        WRITE !,$EXTRACT($PIECE(^PSDRUG(PSAD,0),U),1,39)

 +9                        IF $LENGTH($GET(^PRC(441,+PSAIT,1,1,0)))<40

                               IF '$ORDER(^PRC(441,+PSAIT,1,1))

                                   WRITE ?40,$GET(^PRC(441,+PSAIT,1,1,0))

                                   QUIT 

 +10                       KILL ^UTILITY($JOB,"W")

                           SET DIWL=40

                           SET DIWR=80

                           SET DIWF="W"

 +11                       FOR 

                               SET PSA=$ORDER(^PRC(441,+PSAIT,1,+PSA))

                               IF 'PSA

                                   QUIT 

                               SET X=$GET(^PRC(441,+PSAIT,1,+PSA,0))

                               IF $Y+3>IOSL

                                   DO HEADER

                               IF $GET(PSAOUT)

                                   QUIT 

                               DO ^DIWP

                               DO ^DIWW

 +12                       SET PSA=0

                       End DoDot:1

                   IF $GET(PSAOUT)

                       GOTO QUIT

QUIT       IF $EXTRACT(IOST)'="C"

               WRITE @IOF

 +1        IF $EXTRACT(IOST,1,2)="C-"

               IF 'PSAOUT

                   WRITE !!

                   SET DIR(0)="EA"

                   SET DIR("A")="END OF REPORT!  Press <RET> to return to the menu."

                   DO ^DIR

 +2        DO ^%ZISC

           IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

           KILL IO("Q")

 +3        QUIT 

HEADER    ;prints header info

 +1        IF $EXTRACT(IOST,1,2)'="P-"

               IF PSAPG

                   SET DIR(0)="E"

                   DO ^DIR

                   KILL DIR

                   IF 'Y

                       SET PSAOUT=1

                       QUIT 

 +2        IF $$S^%ZTLOAD

               WRITE !!,"Task #",$GET(ZTSK),", ",$GET(ZTDESC)," was stopped by ",$PIECE($GET(^VA(200,+$GET(DUZ),0)),U),"."

               SET PSAOUT=1

               QUIT 

 +3        IF $Y

               WRITE @IOF

           SET $PIECE(PSALN,"*",81)=""

           SET PSAPG=PSAPG+1

           WRITE !?2,"Unlinked DRUG/ITEM MASTER file entries by common NDC",?55,PSARPDT,?70,"PAGE: "_PSAPG,!,PSALN,!,"DRUG file",?40,"ITEM MASTER file"

 +4        IF $GET(PSA)&($ORDER(^PRC(441,+$GET(PSAIT),1,+$GET(PSA))))

               WRITE !,$PIECE(^PSDRUG(PSAD,0),U)," continued"

 +5        QUIT