source: WorldVistAEHR/trunk/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWDUP.m@ 1604

Last change on this file since 1604 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
RevLine 
[613]1PSGWDUP ;BHAM ISC/KKA-Report for Duplicate entries in ITEM subfile ; 27 Aug 93 / 8:04 AM
2 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
3DUP ; CHECK FOR DUPLICATE ENTRIES IN ITEM SUBFIELD IN 58.1
4 D NOW^%DTC S PSGWDT=X
5 S (OUT,CNT)=0
6 W @IOF,!!,"Duplicate Entries Exist in the ITEM subfile (58.11) of the",!,"PHARMACY AOU STOCK file (#58.1) for the Following Drugs:",!!
7 F PSGWAOU=0:0 S PSGWAOU=$O(^PSI(58.1,PSGWAOU)) Q:'PSGWAOU!(OUT) D
8 .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
9 ..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
10 ..Q:ACNT<2
11 ..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)",!!
12 ..S CNT=CNT+1
13 ..W !,?5,CNT_". ",$P($G(^PSDRUG(PSGWDRG,0)),"^")," ",?50,"AOU: ",$P($G(^PSI(58.1,PSGWAOU,0)),"^")
14 ..S ^TMP("PSGW",$J,CNT,1)=PSGWAOU_"^"_PSGWITM_"^"_PSGWDRG
15 ..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
16 I CNT=0 W !!,?10,"No duplicate entries exist." R !!,"Press RETURN to continue: ",AUTO:DTIME G END
17SLCT ;** select drug(s) which should be printed **
18 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.",!!
19 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
20 I $D(IO("Q")) S ZTRTN="ENTRY^PSGWDUP1",ZTDESC="DUPLICATE REPORT",ZTSAVE("^TMP(""PSGW"",$J,")="",ZTSAVE("PSGWDRP")="" D ^%ZTLOAD,HOME^%ZIS G END
21 U IO
22 D ENTRY^PSGWDUP1
23END ;
24 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
25 W @IOF D ^%ZISC Q
26ACHK ;** continue checking for number of active items
27 S IDT=$P($G(^PSI(58.1,PSGWAOU,1,PSGWITMT,0)),"^",3) S:IDT=""!(IDT>PSGWDT) ACNT=ACNT+1
28 Q
Note: See TracBrowser for help on using the repository browser.