PSXVPN ;BIR/WRT-Report of Local drugs with the same VA Print Name ;[ 10/19/98 8:55 AM ]
;;2.0;CMOP;**18,19,23**;11 Apr 97
;Reference to ^PSDRUG( supported by DBIA #1983
TEXT W !!,"This option will produce a report to help you review your NDF matches.",!
W "The report will group drugs together that are matched to the same VA Print",!,"Name along with the VA Dispense Unit. These will be used for CMOP purposes.",!,"You may queue the report to print, if you wish.",!!
DVC K IO("Q"),%ZIS,POP,IOP S %ZIS="QM",%ZIS("B")="",%ZIS("A")="DEVICE: " D ^%ZIS G:POP DONE W:$E(IOST)'="P" !!,"This report must be run on a printer.",!! G:$E(IOST)'="P" DVC I POP K IOP,POP,IO("Q") Q
QUEUE I $D(IO("Q")) K IO("Q") S ZTRTN="ENQ^PSXVPN" K ZTSAVE,ZTDTH,ZTSK S PSXDEV=ION_";"_IOST_";"_IOM_";"_IOSL,ZTSAVE("PSXDEV")="",ZTSAVE("PSXANS")="",ZTDESC="CMOP Local Drugs with same VA Print Name Report",ZTIO=""
I D ^%ZTLOAD K MJT,%ZIS,POP,IOP,ZTSK D ^%ZISC Q
ENQ ;Called by Taskman to run report of Local drugs with same name report
D LOOP
I $D(ZTQUEUED) D QUEUE1
U IO
ENQ1 S PSXPGCT=0,PSXPGLNG=IOSL-6
D TITLE,LOOP1 W @IOF G DONE
TITLE I $D(IOF),IOF]"" W @IOF S PSXPGCT=PSXPGCT+1
W !,?10,"LOCAL DRUGS MATCHED TO THE SAME VA PRINT NAME",!
S X="T" D ^%DT X ^DD("DD") W ?55,"Date printed: ",Y,!?55,"Page: ",PSXPGCT,!
W !,"VA PRINT NAME",?55,"VA DISPENSE UNIT",!,?5,"Local GENERIC NAME",?60,"Local DISPENSE UNIT",!
F MJT=1:1:80 W "-"
Q
DONE S:$D(ZTQUEUED) ZTREQ="@" K ^TMP($J),PSXB,PSXFLG,PSXAME,PSXCMOP,PSXDN,PSXDP,PSXLDP,PSXGN,PSXLLDP,PSXNDP,PSXNVP,PSXPGCT,PSXPGLNG,ZTRTN,Y,PSXDEV,MJT,PSXLOC,PSXVAP,PSXVP,X,IOP,POP,IO("Q") W:$Y @IOF D ^%ZISC
Q
QUEUE1 S IOP=PSXDEV F D ^%ZIS Q:'POP H 20
Q
LOOP F PSXB=0:0 S PSXB=$O(^PSDRUG(PSXB)) Q:'PSXB I '$D(^PSDRUG(PSXB,"I")),$D(^PSDRUG(PSXB,2)),$P(^PSDRUG(PSXB,2),"^",3)["O",$D(^PSDRUG(PSXB,"ND")),$P(^PSDRUG(PSXB,"ND"),"^",2)]"" D GETVPN
Q
GETVPN K PSXCS S PSXCS=$P($G(^PSDRUG(PSXB,0)),"^",3) I $G(PSXCS)[1!$G(PSXCS)[2 K PSXCS Q
S PSXDN=^PSDRUG(PSXB,"ND"),PSXGN=$P(PSXDN,"^",1),PSXVP=$P(PSXDN,"^",3)
S ZX=$$PROD2^PSNAPIS(PSXGN,PSXVP),PSXVAP=$P($G(ZX),"^"),PSXDP=$P($G(ZX),"^",4) K ZX D NOTNUL
Q
NOTNUL I PSXVAP]"" S:$D(^PSDRUG(PSXB,660)) PSXLDP=$P(^PSDRUG(PSXB,660),"^",8) D TMP
Q
TMP S ^TMP($J,"PSXVP",PSXVAP,PSXB)=PSXDP_"^"_PSXLDP
Q
LOOP1 S PSXNVP="" F S PSXNVP=$O(^TMP($J,"PSXVP",PSXNVP)) Q:PSXNVP="" S PSXFLG=1 D LOOP2
Q
LOOP2 F PSXLOC=0:0 S PSXLOC=$O(^TMP($J,"PSXVP",PSXNVP,PSXLOC)) Q:'PSXLOC S PSXNDP=$P(^TMP($J,"PSXVP",PSXNVP,PSXLOC),"^",1),PSXLLDP=$P(^TMP($J,"PSXVP",PSXNVP,PSXLOC),"^",2),PSXAME=$P(^PSDRUG(PSXLOC,0),"^",1) D WRITE
Q
WRITE D:$Y>PSXPGLNG TITLE W:PSXFLG !,PSXNVP,?55,PSXNDP S PSXFLG=0 W !,?5,PSXAME,?60,PSXLLDP,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXVPN 2718 printed Apr 09, 2024@20:49 Page 2
PSXVPN ;BIR/WRT-Report of Local drugs with the same VA Print Name ;[ 10/19/98 8:55 AM ]
+1 ;;2.0;CMOP;**18,19,23**;11 Apr 97
+2 ;Reference to ^PSDRUG( supported by DBIA #1983
TEXT WRITE !!,"This option will produce a report to help you review your NDF matches.",!
+1 WRITE "The report will group drugs together that are matched to the same VA Print",!,"Name along with the VA Dispense Unit. These will be used for CMOP purposes.",!,"You may queue the report to print, if you wish.",!!
DVC KILL IO("Q"),%ZIS,POP,IOP
SET %ZIS="QM"
SET %ZIS("B")=""
SET %ZIS("A")="DEVICE: "
DO ^%ZIS
if POP
GOTO DONE
if $EXTRACT(IOST)'="P"
WRITE !!,"This report must be run on a printer.",!!
if $EXTRACT(IOST)'="P"
GOTO DVC
IF POP
KILL IOP,POP,IO("Q")
QUIT
QUEUE IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="ENQ^PSXVPN"
KILL ZTSAVE,ZTDTH,ZTSK
SET PSXDEV=ION_";"_IOST_";"_IOM_";"_IOSL
SET ZTSAVE("PSXDEV")=""
SET ZTSAVE("PSXANS")=""
SET ZTDESC="CMOP Local Drugs with same VA Print Name Report"
SET ZTIO=""
+1 IF $TEST
DO ^%ZTLOAD
KILL MJT,%ZIS,POP,IOP,ZTSK
DO ^%ZISC
QUIT
ENQ ;Called by Taskman to run report of Local drugs with same name report
+1 DO LOOP
+2 IF $DATA(ZTQUEUED)
DO QUEUE1
+3 USE IO
ENQ1 SET PSXPGCT=0
SET PSXPGLNG=IOSL-6
+1 DO TITLE
DO LOOP1
WRITE @IOF
GOTO DONE
TITLE IF $DATA(IOF)
IF IOF]""
WRITE @IOF
SET PSXPGCT=PSXPGCT+1
+1 WRITE !,?10,"LOCAL DRUGS MATCHED TO THE SAME VA PRINT NAME",!
+2 SET X="T"
DO ^%DT
XECUTE ^DD("DD")
WRITE ?55,"Date printed: ",Y,!?55,"Page: ",PSXPGCT,!
+3 WRITE !,"VA PRINT NAME",?55,"VA DISPENSE UNIT",!,?5,"Local GENERIC NAME",?60,"Local DISPENSE UNIT",!
+4 FOR MJT=1:1:80
WRITE "-"
+5 QUIT
DONE if $DATA(ZTQUEUED)
SET ZTREQ="@"
KILL ^TMP($JOB),PSXB,PSXFLG,PSXAME,PSXCMOP,PSXDN,PSXDP,PSXLDP,PSXGN,PSXLLDP,PSXNDP,PSXNVP,PSXPGCT,PSXPGLNG,ZTRTN,Y,PSXDEV,MJT,PSXLOC,PSXVAP,PSXVP,X,IOP,POP,IO("Q")
if $Y
WRITE @IOF
DO ^%ZISC
+1 QUIT
QUEUE1 SET IOP=PSXDEV
FOR
DO ^%ZIS
if 'POP
QUIT
HANG 20
+1 QUIT
LOOP FOR PSXB=0:0
SET PSXB=$ORDER(^PSDRUG(PSXB))
if 'PSXB
QUIT
IF '$DATA(^PSDRUG(PSXB,"I"))
IF $DATA(^PSDRUG(PSXB,2))
IF $PIECE(^PSDRUG(PSXB,2),"^",3)["O"
IF $DATA(^PSDRUG(PSXB,"ND"))
IF $PIECE(^PSDRUG(PSXB,"ND"),"^",2)]""
DO GETVPN
+1 QUIT
GETVPN KILL PSXCS
SET PSXCS=$PIECE($GET(^PSDRUG(PSXB,0)),"^",3)
IF $GET(PSXCS)[1!$GET(PSXCS)[2
KILL PSXCS
QUIT
+1 SET PSXDN=^PSDRUG(PSXB,"ND")
SET PSXGN=$PIECE(PSXDN,"^",1)
SET PSXVP=$PIECE(PSXDN,"^",3)
+2 SET ZX=$$PROD2^PSNAPIS(PSXGN,PSXVP)
SET PSXVAP=$PIECE($GET(ZX),"^")
SET PSXDP=$PIECE($GET(ZX),"^",4)
KILL ZX
DO NOTNUL
+3 QUIT
NOTNUL IF PSXVAP]""
if $DATA(^PSDRUG(PSXB,660))
SET PSXLDP=$PIECE(^PSDRUG(PSXB,660),"^",8)
DO TMP
+1 QUIT
TMP SET ^TMP($JOB,"PSXVP",PSXVAP,PSXB)=PSXDP_"^"_PSXLDP
+1 QUIT
LOOP1 SET PSXNVP=""
FOR
SET PSXNVP=$ORDER(^TMP($JOB,"PSXVP",PSXNVP))
if PSXNVP=""
QUIT
SET PSXFLG=1
DO LOOP2
+1 QUIT
LOOP2 FOR PSXLOC=0:0
SET PSXLOC=$ORDER(^TMP($JOB,"PSXVP",PSXNVP,PSXLOC))
if 'PSXLOC
QUIT
SET PSXNDP=$PIECE(^TMP($JOB,"PSXVP",PSXNVP,PSXLOC),"^",1)
SET PSXLLDP=$PIECE(^TMP($JOB,"PSXVP",PSXNVP,PSXLOC),"^",2)
SET PSXAME=$PIECE(^PSDRUG(PSXLOC,0),"^",1)
DO WRITE
+1 QUIT
WRITE if $Y>PSXPGLNG
DO TITLE
if PSXFLG
WRITE !,PSXNVP,?55,PSXNDP
SET PSXFLG=0
WRITE !,?5,PSXAME,?60,PSXLLDP,!
+1 QUIT
