PSALNM.m

PSALNM ;BIR/LTL-NDC Duplicates Report (ITEM MASTER file) ;7/23/97

 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97

 ;This routine manually loops through the DRUG file for any unmatched

 ;entries that have an NDC link to an item in the ITEM MASTER file.

 ;

 D DT^DICRW

START ;sets up edit loop

 N D0,D1,DA,DIC,DIE,DLAYGO,DR,DTOUT,DUOUT,DIRUT,PSA,PSAD,PSADD,PSAIT,X,Y S (PSA,PSAD)=0,Y=1

EXPL W !,"I'll look through your DRUG file for any unmatched entries that have",!,"an NDC link to an item in the ITEM MASTER file.",!

LOOP F  K PSADD S PSAD=$O(^PSDRUG(PSAD)) G:'PSAD!($D(DIRUT)) QUIT I $P($G(^PSDRUG(PSAD,2)),U,4)]"" S PSAD(1)=$P($G(^(2)),U,4) D:'$D(^PSDRUG(PSAD,"I"))

 .S PSAIT=$$ITEM^PSAUTL(PSAD(1)) Q:'PSAIT  I $D(^PRC(441,+PSAIT,0)) D  Q:$D(PSADD)  W !,$E($P(^PSDRUG(PSAD,0),U),1,39)

NOT ..S:$O(^PSDRUG("AB",PSAIT,"")) PSADD="" I $D(^PRC(441,PSAIT,3)),$P(^(3),U)=1 S PSADD=""

 .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)) G ED

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

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

 .S PSA=0

ED .S DIR(0)="Y",DIR("A")="Do we have a match",DIR("B")="Yes" W ! D ^DIR K DIR W ! Q:Y<1  D

OK ..S DIE=50,DA=PSAD,DR="441///^S X=PSAIT" D ^DIE W "  Linked to Item #"_PSAIT

QUIT Q

PSALNM    ;BIR/LTL-NDC Duplicates Report (ITEM MASTER file) ;7/23/97

 +1       ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97

 +2       ;This routine manually loops through the DRUG file for any unmatched

 +3       ;entries that have an NDC link to an item in the ITEM MASTER file.

 +4       ;

 +5        DO DT^DICRW

START     ;sets up edit loop

 +1        NEW D0,D1,DA,DIC,DIE,DLAYGO,DR,DTOUT,DUOUT,DIRUT,PSA,PSAD,PSADD,PSAIT,X,Y

           SET (PSA,PSAD)=0

           SET Y=1

EXPL       WRITE !,"I'll look through your DRUG file for any unmatched entries that have",!,"an NDC link to an item in the ITEM MASTER file.",!

LOOP       FOR 

               KILL PSADD

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

               IF 'PSAD!($DATA(DIRUT))

                   GOTO QUIT

               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))

                           IF 'PSAIT

                               QUIT 

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

                               Begin DoDot:2

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

                                       SET PSADD=""

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

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

                                           SET PSADD=""

                               End DoDot:2

                               IF $DATA(PSADD)

                                   QUIT 

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

 +1                        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))

                                   GOTO ED

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

                           SET DIWL=40

                           SET DIWR=80

                           SET DIWP="W"

 +3                        FOR 

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

                               IF 'PSA

                                   QUIT 

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

                               DO ^DIWP

                               DO ^DIWW

 +4                        SET PSA=0

ED                         SET DIR(0)="Y"

                           SET DIR("A")="Do we have a match"

                           SET DIR("B")="Yes"

                           WRITE !

                           DO ^DIR

                           KILL DIR

                           WRITE !

                           IF Y<1

                               QUIT 

                           Begin DoDot:2

OK                             SET DIE=50

                               SET DA=PSAD

                               SET DR="441///^S X=PSAIT"

                               DO ^DIE

                               WRITE "  Linked to Item #"_PSAIT

                           End DoDot:2

                       End DoDot:1

QUIT       QUIT