- 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
