- 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
- 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
