Routine: PSBIHS2

PSBIHS2 ;KF/VAOIT  PSB DRUG REPORT

 ;;1.0;PSB BCMA CPS FOXK;**1018**;;Build 27

EN ;

 W @IOF

 W !,"Hello ",$P($$GET1^DIQ(200,DUZ,.01,"E"),",",2)

 W !,"Let's Look at those 'Synonyms' in 'The Drug File' File: 50"

 W !,"Searching....." D WAIT^DICD W !

 S UIO1=IO ;SAVE IO

 ;MAKE SURE TO OPEN NULL DEVICE.

 S DIC=3.5,DIC(0)="M" S X="NULL" D ^DIC

 S IOP="`"_+Y D ^%ZIS

 S UIO=$P($G(^%ZIS(1,+Y,0)),U,2)

 Q:POP

 D NEW,BAD

TAS ;TASK IT OR NOT

 S %ZIS="Q"

 W ! D ^%ZIS K %ZIS

 I POP D  Q

 .W $C(7)

 .K VISN,PSBEDATE,PSBBDATE,PSBDV

 ; output not queued...

 N PSBTK

 I '$D(IO("Q")) D

 .D WAIT^DICD U IO D PRNT

 .I IO'=IO(0) D ^%ZISC

 ; set up the Task...

 I $D(IO("Q")) D

 .N ZTDESC,ZTSAVE,ZTIO,ZTRTN

 .S ZTRTN="TSK1^PSBIHS2"

 .S ZTDESC="PSB Drug File Synonym Report"

 .S ZTIO=ION

 .D ^%ZTLOAD

 .D HOME^%ZIS

 .W !,$S($G(ZTSK):"Task number "_ZTSK_" queued.",1:"ERROR -- NOT QUEUED!")

 .K IO("Q"),ZTSK

NEW ;

 K ^TMP($J) S (PSBCNT,PSBCNT1,PSBC)=0

 ;COLLECT ALL DRUG SYNONYM IN TMP IF IT FAILS SMED^PSBMLTS

 N PSBIEN,PSBJ

 S PSBIEN=0 F  S PSBIEN=$O(^PSDRUG(PSBIEN)) Q:'+PSBIEN  D

 .K PSBSCAN D SMED^PSBMLTS(.PSBSCAN,PSBIEN)

 .;Q:+PSBSCAN(0)>0 ;IEN PASSED ITS OKAY

 .;IF DRUG IEN FAILS SMED&PSBMLTS ADD IEN TO LIST OF SYNS/IENS

 .I '$D(^TMP($J,"SYN",PSBIEN))&(+PSBSCAN(0)'>0) S ^TMP($J,"SYN",PSBIEN)=""

 .S PSBJ=0 F  S PSBJ=$O(^PSDRUG(PSBIEN,1,PSBJ)) Q:'+PSBJ  D

 ..;get ALL synm for ALL Drugs.

 ..S PSBTEXT=$P($G(^PSDRUG(PSBIEN,1,PSBJ,0)),"^",1)

 ..N J F J=1:1:$L(PSBTEXT) I $E(PSBTEXT,J,J)?.1A S PSBTEXT="NO" Q  ;;no alpha only syns allowed in list.

 ..K PSBSCAN D SMED^PSBMLTS(.PSBSCAN,PSBTEXT)

 ..Q:+PSBSCAN(0)>0  ;IEN PASSED ITS OKAY

 ..S:+PSBTEXT ^TMP($J,"SYN",PSBTEXT)=""

TSK1 ;

 D NEW,PRNT,KILL

BAD ;INACTIVE DRUGS  WITH DUP SYNS

 S PSBSYN="" F  S PSBSYN=$O(^TMP($J,"SYN",PSBSYN)) Q:PSBSYN'>0  D SMED(PSBSYN,2,1)

 I $D(^TMP($J,"BADSYN")) D

 .S PSBSYN="" F  S PSBSYN=$O(^TMP($J,"BADSYN",PSBSYN)) Q:PSBSYN=""  D SMED(PSBSYN,2,0)

 .D AUTO

PRNT ;REPORT LOOP

 S PSBSYN="" F  S PSBSYN=$O(^TMP($J,"SYN",PSBSYN)) Q:PSBSYN'>0  D SMED(PSBSYN,2,0)

 W !,"Found "_PSBC_" Synonym Issues."

SMED(PSBVAL,PSBL,PSBCH) ; SAME LOGIC in Scanner^PSBMLTS

 ;PSBVAL DRUG OR SYN

 ;PSBL FOUND CNT

 ;PSBCH O WRITE DETAIL, 1 HIDE DETAILS INACTIVE SEARCH FIRST.

 K ^TMP("DILIST",$J)

 ;U "//./nul" HIDE ECHO BACK DISPLAY

 U UIO D FIND^DIC(50,"","","AX",PSBVAL,"*","B^C")

 U UIO1 ;BACK TO REG DEVICE.

 Q:+$G(^TMP("DILIST",$J,0))<PSBL  ;ITS OKAY BAIL OUT

 S PSBC=PSBC+1

 W:PSBCH=0 !!,"There are ",+^TMP("DILIST",$J,0)," matches to '",PSBVAL,"'."

 F PSBX=0:0 S PSBX=$O(^TMP("DILIST",$J,2,PSBX)) Q:'PSBX  D

 .W:PSBCH=0 !!,"MATCH #:..................",PSBX

 .W:PSBCH=0 !,"IEN:......................",^TMP("DILIST",$J,2,PSBX)

 .W:PSBCH=0 !,"NAME:.....................",^TMP("DILIST",$J,1,PSBX)

 .S PSBFLD=0

 .F  S PSBFLD=$O(^TMP("DILIST",$J,"ID",PSBX,PSBFLD)) Q:'PSBFLD  D

 ..D FIELD^DID(50,PSBFLD,"","LABEL","PSBFLD")

 ..; IF PREVIEW ONLY LABEL IS INATACTVIE DRUG AND HAS A DATE, AND PASSED VAL IS NOT SAME DRUG IEN.

 ..I PSBCH=1&(PSBFLD("LABEL")="INACTIVE DATE")&($G(^TMP("DILIST",$J,"ID",PSBX,PSBFLD))'="")&(PSBVAL'=^TMP("DILIST",$J,2,PSBX)) D

 ...S ^TMP($J,"BAD2",^TMP("DILIST",$J,2,PSBX))="",^TMP($J,"BADSYN",PSBVAL)="",PSBCNT=PSBCNT+1

 ...W !,"IEN:......................",^TMP("DILIST",$J,2,PSBX)

 ...W !,"NAME:.....................",^TMP("DILIST",$J,1,PSBX)

 ..I PSBCH=0 W !,PSBFLD("LABEL"),":" F  Q:$X>25  W "."

 ..W:PSBCH=0 ^TMP("DILIST",$J,"ID",PSBX,PSBFLD)

 I PSBCH=0 W ! F J=1:1:IOM W "-"

 K ^TMP("DILIST",$J)

AUTO; REMOVE SYNONYMS FROM INACTIVE DRUGS.

 Q:'$D(^TMP($J,"BAD2"))

 W !,"Hello,"_$P($$GET1^DIQ(200,DUZ,.01,"E"),",",2),!,"I found Dupiclate synonyms on Inactive Drugs, would youlike me clean these up for up?" S %=2 D YN^DICN

 I '$D(^XUSEC("PSJ RPHARM",DUZ)) W !,"Sorry ",$P($$GET1^DIQ(200,DUZ,.01,"E"),",",2)," you dO not hold the 'PSJ RHARM' key Bye!!" 	Q

 Q:%'=1

 N PSBCNT,PSBC

 S (PSBC,PSBCNT)=0

 S DIK="^PSDRUG(DA(1),1,"

 S PSBCNT=0,PSBIEN=0 F  S PSBIEN=$O(^TMP($J,"BAD2",PSBIEN)) Q:PSBIEN'>0  D

 .S DA(1)=PSBIEN,PSBC=PSBC+1

 .S PSBJ=0 F  S PSBJ=$O(^PSDRUG(PSBIEN,1,PSBJ)) Q:'+PSBJ  D

 ..S DA=PSBJ D ^DIK S PSBCNT=PSBCNT+1

 W !,"All Done you just removed "_PSBCNT_" Synonyms from "_PSBC_" Drugs."

 K PSBIEN,DA(1),DA,DIK,PSBCNT,PSBC

KILL ;

 K PSBIEN,PSBIEN1,PSBH,PSBJ,PSBCNT,PSBCNT1,PSBSYN,^TMP($J),PSBSYNC,PSBCHECK1,PSBTEXT,PSBC,PSBCHECK

PSBIHS2   ;KF/VAOIT  PSB DRUG REPORT

 +1       ;;1.0;PSB BCMA CPS FOXK;**1018**;;Build 27

EN        ;

 +1        WRITE @IOF

 +2        WRITE !,"Hello ",$PIECE($$GET1^DIQ(200,DUZ,.01,"E"),",",2)

 +3        WRITE !,"Let's Look at those 'Synonyms' in 'The Drug File' File: 50"

 +4        WRITE !,"Searching....."

           DO WAIT^DICD

           WRITE !

 +5       ;SAVE IO

           SET UIO1=IO

 +6       ;MAKE SURE TO OPEN NULL DEVICE.

 +7        SET DIC=3.5

           SET DIC(0)="M"

           SET X="NULL"

           DO ^DIC

 +8        SET IOP="`"_+Y

           DO ^%ZIS

 +9        SET UIO=$PIECE($GET(^%ZIS(1,+Y,0)),U,2)

 +10       IF POP

               QUIT

 +11       DO NEW

           DO BAD

TAS       ;TASK IT OR NOT

 +1        SET %ZIS="Q"

 +2        WRITE !

           DO ^%ZIS

           KILL %ZIS

 +3        IF POP

               Begin DoDot:1

 +4                WRITE $CHAR(7)

 +5                KILL VISN,PSBEDATE,PSBBDATE,PSBDV

               End DoDot:1

               QUIT

 +6       ; output not queued...

 +7        NEW PSBTK

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

               Begin DoDot:1

 +9                DO WAIT^DICD

                   USE IO

                   DO PRNT

 +10               IF IO'=IO(0)

                       DO ^%ZISC

               End DoDot:1

 +11      ; set up the Task...

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

               Begin DoDot:1

 +13               NEW ZTDESC,ZTSAVE,ZTIO,ZTRTN

 +14               SET ZTRTN="TSK1^PSBIHS2"

 +15               SET ZTDESC="PSB Drug File Synonym Report"

 +16               SET ZTIO=ION

 +17               DO ^%ZTLOAD

 +18               DO HOME^%ZIS

 +19               WRITE !,$SELECT($GET(ZTSK):"Task number "_ZTSK_" queued.",1:"ERROR -- NOT QUEUED!")

 +20               KILL IO("Q"),ZTSK

               End DoDot:1

 +21       QUIT

NEW       ;

 +1        KILL ^TMP($JOB)

           SET (PSBCNT,PSBCNT1,PSBC)=0

 +2       ;COLLECT ALL DRUG SYNONYM IN TMP IF IT FAILS SMED^PSBMLTS

 +3        NEW PSBIEN,PSBJ

 +4        SET PSBIEN=0

FOR

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

               IF '+PSBIEN

                   QUIT

               Begin DoDot:1

 +5                KILL PSBSCAN

                   DO SMED^PSBMLTS(.PSBSCAN,PSBIEN)

 +6       ;Q:+PSBSCAN(0)>0 ;IEN PASSED ITS OKAY

 +7       ;IF DRUG IEN FAILS SMED&PSBMLTS ADD IEN TO LIST OF SYNS/IENS

 +8                IF '$DATA(^TMP($JOB,"SYN",PSBIEN))&(+PSBSCAN(0)'>0)

                       SET ^TMP($JOB,"SYN",PSBIEN)=""

 +9                SET PSBJ=0

FOR

                       SET PSBJ=$ORDER(^PSDRUG(PSBIEN,1,PSBJ))

                       IF '+PSBJ

                           QUIT

                       Begin DoDot:2

 +10      ;get ALL synm for ALL Drugs.

 +11                       SET PSBTEXT=$PIECE($GET(^PSDRUG(PSBIEN,1,PSBJ,0)),"^",1)

 +12      ;;no alpha only syns allowed in list.

                           NEW J

                           FOR J=1:1:$LENGTH(PSBTEXT)

                               IF $EXTRACT(PSBTEXT,J,J)?.1A

                                   SET PSBTEXT="NO"

                                   QUIT

 +13                       KILL PSBSCAN

                           DO SMED^PSBMLTS(.PSBSCAN,PSBTEXT)

 +14      ;IEN PASSED ITS OKAY

                           IF +PSBSCAN(0)>0

                               QUIT

 +15                       IF +PSBTEXT

                               SET ^TMP($JOB,"SYN",PSBTEXT)=""

                       End DoDot:2

               End DoDot:1

 +16      ;

 +17       QUIT

TSK1      ;

 +1        DO NEW

           DO PRNT

           DO KILL

 +2        QUIT

BAD       ;INACTIVE DRUGS  WITH DUP SYNS

 +1        SET PSBSYN=""

FOR

               SET PSBSYN=$ORDER(^TMP($JOB,"SYN",PSBSYN))

               IF PSBSYN'>0

                   QUIT

               DO SMED(PSBSYN,2,1)

 +2        IF $DATA(^TMP($JOB,"BADSYN"))

               Begin DoDot:1

 +3                SET PSBSYN=""

FOR

                       SET PSBSYN=$ORDER(^TMP($JOB,"BADSYN",PSBSYN))

                       IF PSBSYN=""

                           QUIT

                       DO SMED(PSBSYN,2,0)

 +4                DO AUTO

               End DoDot:1

 +5        QUIT

PRNT      ;REPORT LOOP

 +1        SET PSBSYN=""

FOR

               SET PSBSYN=$ORDER(^TMP($JOB,"SYN",PSBSYN))

               IF PSBSYN'>0

                   QUIT

               DO SMED(PSBSYN,2,0)

 +2        WRITE !,"Found "_PSBC_" Synonym Issues."

 +3        QUIT

SMED(PSBVAL,PSBL,PSBCH) ; SAME LOGIC in Scanner^PSBMLTS

 +1       ;PSBVAL DRUG OR SYN

 +2       ;PSBL FOUND CNT

 +3       ;PSBCH O WRITE DETAIL, 1 HIDE DETAILS INACTIVE SEARCH FIRST.

 +4        KILL ^TMP("DILIST",$JOB)

 +5       ;U "//./nul" HIDE ECHO BACK DISPLAY

 +6        USE UIO

           DO FIND^DIC(50,"","","AX",PSBVAL,"*","B^C")

 +7       ;BACK TO REG DEVICE.

           USE UIO1

 +8       ;ITS OKAY BAIL OUT

           IF +$GET(^TMP("DILIST",$JOB,0))<PSBL

               QUIT

 +9        SET PSBC=PSBC+1

 +10       IF PSBCH=0

               WRITE !!,"There are ",+^TMP("DILIST",$JOB,0)," matches to '",PSBVAL,"'."

 +11       FOR PSBX=0:0

               SET PSBX=$ORDER(^TMP("DILIST",$JOB,2,PSBX))

               IF 'PSBX

                   QUIT

               Begin DoDot:1

 +12               IF PSBCH=0

                       WRITE !!,"MATCH #:..................",PSBX

 +13               IF PSBCH=0

                       WRITE !,"IEN:......................",^TMP("DILIST",$JOB,2,PSBX)

 +14               IF PSBCH=0

                       WRITE !,"NAME:.....................",^TMP("DILIST",$JOB,1,PSBX)

 +15               SET PSBFLD=0

 +16               FOR

                       SET PSBFLD=$ORDER(^TMP("DILIST",$JOB,"ID",PSBX,PSBFLD))

                       IF 'PSBFLD

                           QUIT

                       Begin DoDot:2

 +17                       DO FIELD^DID(50,PSBFLD,"","LABEL","PSBFLD")

 +18      ; IF PREVIEW ONLY LABEL IS INATACTVIE DRUG AND HAS A DATE, AND PASSED VAL IS NOT SAME DRUG IEN.

 +19                       IF PSBCH=1&(PSBFLD("LABEL")="INACTIVE DATE")&($GET(^TMP("DILIST",$JOB,"ID",PSBX,PSBFLD))'="")&(PSBVAL'=^TMP("DILIST",$JOB,2,PSBX))

                               Begin DoDot:3

 +20                               SET ^TMP($JOB,"BAD2",^TMP("DILIST",$JOB,2,PSBX))=""

                                   SET ^TMP($JOB,"BADSYN",PSBVAL)=""

                                   SET PSBCNT=PSBCNT+1

 +21                               WRITE !,"IEN:......................",^TMP("DILIST",$JOB,2,PSBX)

 +22                               WRITE !,"NAME:.....................",^TMP("DILIST",$JOB,1,PSBX)

                               End DoDot:3

 +23                       IF PSBCH=0

                               WRITE !,PSBFLD("LABEL"),":"

FOR

                                   IF $X>25

                                       QUIT

                                   WRITE "."

 +24                       IF PSBCH=0

                               WRITE ^TMP("DILIST",$JOB,"ID",PSBX,PSBFLD)

                       End DoDot:2

               End DoDot:1

 +25       IF PSBCH=0

               WRITE !

               FOR J=1:1:IOM

                   WRITE "-"

 +26       KILL ^TMP("DILIST",$JOB)

 +27       QUIT

AUTO;

*** ERROR ***

 +1        IF '$DATA(^TMP($JOB,"BAD2"))

               QUIT

 +2        WRITE !,"Hello,"_$PIECE($$GET1^DIQ(200,DUZ,.01,"E"),",",2),!,"I found Dupiclate synonyms on Inactive Drugs, would youlike me clean these up for up?"

           SET %=2

           DO YN^DICN

 +3        IF '$DATA(^XUSEC("PSJ RPHARM",DUZ))

               WRITE !,"Sorry ",$PIECE($$GET1^DIQ(200,DUZ,.01,"E"),",",2)," you dO not hold the 'PSJ RHARM' key Bye!!"

PSBIHS2.m