PSGWDUP.m

PSGWDUP ;BHAM ISC/KKA-Report for Duplicate entries in ITEM subfile ; 27 Aug 93 / 8:04 AM

 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94

DUP ; CHECK FOR DUPLICATE ENTRIES IN ITEM SUBFIELD IN 58.1

 D NOW^%DTC S PSGWDT=X

 S (OUT,CNT)=0

 W @IOF,!!,"Duplicate Entries Exist in the ITEM subfile (58.11) of the",!,"PHARMACY AOU STOCK file (#58.1) for the Following Drugs:",!!

 F PSGWAOU=0:0 S PSGWAOU=$O(^PSI(58.1,PSGWAOU)) Q:'PSGWAOU!(OUT)  D

 .F PSGWDRG=0:0 S PSGWDRG=$O(^PSI(58.1,PSGWAOU,1,"B",PSGWDRG)) Q:'PSGWDRG!(OUT)  S PSGWITM=$O(^PSI(58.1,PSGWAOU,1,"B",PSGWDRG,0)) I $O(^PSI(58.1,PSGWAOU,1,"B",PSGWDRG,PSGWITM)) S ACNT=0 D

 ..S PSGWITMT=PSGWITM,IDT=$P($G(^PSI(58.1,PSGWAOU,1,PSGWITMT,0)),"^",3) S:IDT=""!(IDT>PSGWDT) ACNT=1 F  S PSGWITMT=$O(^PSI(58.1,PSGWAOU,1,"B",PSGWDRG,PSGWITMT)) Q:'PSGWITMT  D ACHK

 ..Q:ACNT<2

 ..I $Y+5>IOSL W !!,"Press RETURN to continue or ""^"" to exit: " R CONT:DTIME S:CONT["^" OUT=1 Q:OUT  W @IOF,"Duplicate Entries (continued)",!!

 ..S CNT=CNT+1

 ..W !,?5,CNT_". ",$P($G(^PSDRUG(PSGWDRG,0)),"^"),"  ",?50,"AOU: ",$P($G(^PSI(58.1,PSGWAOU,0)),"^")

 ..S ^TMP("PSGW",$J,CNT,1)=PSGWAOU_"^"_PSGWITM_"^"_PSGWDRG

 ..S CNT2=2 F  S PSGWITM=$O(^PSI(58.1,PSGWAOU,1,"B",PSGWDRG,PSGWITM)) Q:'PSGWITM  S ^TMP("PSGW",$J,CNT,CNT2)=PSGWAOU_"^"_PSGWITM_"^"_PSGWDRG,CNT2=CNT2+1

 I CNT=0 W !!,?10,"No duplicate entries exist." R !!,"Press RETURN to continue: ",AUTO:DTIME G END

SLCT ;** select drug(s) which should be printed **

 W !! S DIR(0)="LOA^1:"_CNT,DIR("A")="Print report for which drugs (1-"_CNT_"): " D ^DIR K DIR G:"^"[Y END S PSGWDRP=Y W !!,"The right margin for this report is 132.",!,"You may queue the report to print at a later time.",!!

 K IO("Q"),%ZIS,IOP S %ZIS="MQ" S %ZIS("B")="" D ^%ZIS K %ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED." Q

 I $D(IO("Q")) S ZTRTN="ENTRY^PSGWDUP1",ZTDESC="DUPLICATE REPORT",ZTSAVE("^TMP(""PSGW"",$J,")="",ZTSAVE("PSGWDRP")="" D ^%ZTLOAD,HOME^%ZIS G END

 U IO

 D ENTRY^PSGWDUP1

END ;    

 K CNT,CNT2,CONT,POP,PSGWAOU,PSGWDRG,PSGWDRP,PSGWITM,ZTDESC,ZTRTN,ZTSAVE("PSGWDRP"),ZTSAVE("^TMP(""PSGW"",$J)"),^TMP("PSGW",$J),OUT,Y,X,%,%H,%I,PSGWDT,PSGWITMT,ACNT,IDT,AUTO

 W @IOF D ^%ZISC Q

ACHK ;** continue checking for number of active items

 S IDT=$P($G(^PSI(58.1,PSGWAOU,1,PSGWITMT,0)),"^",3) S:IDT=""!(IDT>PSGWDT) ACNT=ACNT+1

 Q

PSGWDUP   ;BHAM ISC/KKA-Report for Duplicate entries in ITEM subfile ; 27 Aug 93 / 8:04 AM

 +1       ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94

DUP       ; CHECK FOR DUPLICATE ENTRIES IN ITEM SUBFIELD IN 58.1

 +1        DO NOW^%DTC

           SET PSGWDT=X

 +2        SET (OUT,CNT)=0

 +3        WRITE @IOF,!!,"Duplicate Entries Exist in the ITEM subfile (58.11) of the",!,"PHARMACY AOU STOCK file (#58.1) for the Following Drugs:",!!

 +4        FOR PSGWAOU=0:0

               SET PSGWAOU=$ORDER(^PSI(58.1,PSGWAOU))

               IF 'PSGWAOU!(OUT)

                   QUIT 

               Begin DoDot:1

 +5                FOR PSGWDRG=0:0

                       SET PSGWDRG=$ORDER(^PSI(58.1,PSGWAOU,1,"B",PSGWDRG))

                       IF 'PSGWDRG!(OUT)

                           QUIT 

                       SET PSGWITM=$ORDER(^PSI(58.1,PSGWAOU,1,"B",PSGWDRG,0))

                       IF $ORDER(^PSI(58.1,PSGWAOU,1,"B",PSGWDRG,PSGWITM))

                           SET ACNT=0

                           Begin DoDot:2

 +6                            SET PSGWITMT=PSGWITM

                               SET IDT=$PIECE($GET(^PSI(58.1,PSGWAOU,1,PSGWITMT,0)),"^",3)

                               IF IDT=""!(IDT>PSGWDT)

                                   SET ACNT=1

                               FOR 

                                   SET PSGWITMT=$ORDER(^PSI(58.1,PSGWAOU,1,"B",PSGWDRG,PSGWITMT))

                                   IF 'PSGWITMT

                                       QUIT 

                                   DO ACHK

 +7                            IF ACNT<2

                                   QUIT 

 +8                            IF $Y+5>IOSL

                                   WRITE !!,"Press RETURN to continue or ""^"" to exit: "

                                   READ CONT:DTIME

                                   IF CONT["^"

                                       SET OUT=1

                                   IF OUT

                                       QUIT 

                                   WRITE @IOF,"Duplicate Entries (continued)",!!

 +9                            SET CNT=CNT+1

 +10                           WRITE !,?5,CNT_". ",$PIECE($GET(^PSDRUG(PSGWDRG,0)),"^"),"  ",?50,"AOU: ",$PIECE($GET(^PSI(58.1,PSGWAOU,0)),"^")

 +11                           SET ^TMP("PSGW",$JOB,CNT,1)=PSGWAOU_"^"_PSGWITM_"^"_PSGWDRG

 +12                           SET CNT2=2

                               FOR 

                                   SET PSGWITM=$ORDER(^PSI(58.1,PSGWAOU,1,"B",PSGWDRG,PSGWITM))

                                   IF 'PSGWITM

                                       QUIT 

                                   SET ^TMP("PSGW",$JOB,CNT,CNT2)=PSGWAOU_"^"_PSGWITM_"^"_PSGWDRG

                                   SET CNT2=CNT2+1

                           End DoDot:2

               End DoDot:1

 +13       IF CNT=0

               WRITE !!,?10,"No duplicate entries exist."

               READ !!,"Press RETURN to continue: ",AUTO:DTIME

               GOTO END

SLCT      ;** select drug(s) which should be printed **

 +1        WRITE !!

           SET DIR(0)="LOA^1:"_CNT

           SET DIR("A")="Print report for which drugs (1-"_CNT_"): "

           DO ^DIR

           KILL DIR

           IF "^"[Y

               GOTO END

           SET PSGWDRP=Y

           WRITE !!,"The right margin for this report is 132.",!,"You may queue the report to print at a later time.",!!

 +2        KILL IO("Q"),%ZIS,IOP

           SET %ZIS="MQ"

           SET %ZIS("B")=""

           DO ^%ZIS

           KILL %ZIS

           IF POP

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

               QUIT 

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

               SET ZTRTN="ENTRY^PSGWDUP1"

               SET ZTDESC="DUPLICATE REPORT"

               SET ZTSAVE("^TMP(""PSGW"",$J,")=""

               SET ZTSAVE("PSGWDRP")=""

               DO ^%ZTLOAD

               DO HOME^%ZIS

               GOTO END

 +4        USE IO

 +5        DO ENTRY^PSGWDUP1

END       ;    

 +1        KILL CNT,CNT2,CONT,POP,PSGWAOU,PSGWDRG,PSGWDRP,PSGWITM,ZTDESC,ZTRTN,ZTSAVE("PSGWDRP"),ZTSAVE("^TMP(""PSGW"",$J)"),^TMP("PSGW",$JOB),OUT,Y,X,%,%H,%I,PSGWDT,PSGWITMT,ACNT,IDT,AUTO

 +2        WRITE @IOF

           DO ^%ZISC

           QUIT 

ACHK      ;** continue checking for number of active items

 +1        SET IDT=$PIECE($GET(^PSI(58.1,PSGWAOU,1,PSGWITMT,0)),"^",3)

           IF IDT=""!(IDT>PSGWDT)

               SET ACNT=ACNT+1

 +2        QUIT