source: FOIAVistA/tag/r/CMOP-PSX/PSXVPN.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 2.6 KB
Line 
1PSXVPN ;BIR/WRT-Report of Local drugs with the same VA Print Name ;[ 10/19/98 8:55 AM ]
2 ;;2.0;CMOP;**18,19,23**;11 Apr 97
3 ;Reference to ^PSDRUG( supported by DBIA #1983
4TEXT W !!,"This option will produce a report to help you review your NDF matches.",!
5 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.",!!
6DVC 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
7QUEUE 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=""
8 I D ^%ZTLOAD K MJT,%ZIS,POP,IOP,ZTSK D ^%ZISC Q
9ENQ ;Called by Taskman to run report of Local drugs with same name report
10 D LOOP
11 I $D(ZTQUEUED) D QUEUE1
12 U IO
13ENQ1 S PSXPGCT=0,PSXPGLNG=IOSL-6
14 D TITLE,LOOP1 W @IOF G DONE
15TITLE I $D(IOF),IOF]"" W @IOF S PSXPGCT=PSXPGCT+1
16 W !,?10,"LOCAL DRUGS MATCHED TO THE SAME VA PRINT NAME",!
17 S X="T" D ^%DT X ^DD("DD") W ?55,"Date printed: ",Y,!?55,"Page: ",PSXPGCT,!
18 W !,"VA PRINT NAME",?55,"VA DISPENSE UNIT",!,?5,"Local GENERIC NAME",?60,"Local DISPENSE UNIT",!
19 F MJT=1:1:80 W "-"
20 Q
21DONE 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
22 Q
23QUEUE1 S IOP=PSXDEV F D ^%ZIS Q:'POP H 20
24 Q
25LOOP 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
26 Q
27GETVPN K PSXCS S PSXCS=$P($G(^PSDRUG(PSXB,0)),"^",3) I $G(PSXCS)[1!$G(PSXCS)[2 K PSXCS Q
28 S PSXDN=^PSDRUG(PSXB,"ND"),PSXGN=$P(PSXDN,"^",1),PSXVP=$P(PSXDN,"^",3)
29 S ZX=$$PROD2^PSNAPIS(PSXGN,PSXVP),PSXVAP=$P($G(ZX),"^"),PSXDP=$P($G(ZX),"^",4) K ZX D NOTNUL
30 Q
31NOTNUL I PSXVAP]"" S:$D(^PSDRUG(PSXB,660)) PSXLDP=$P(^PSDRUG(PSXB,660),"^",8) D TMP
32 Q
33TMP S ^TMP($J,"PSXVP",PSXVAP,PSXB)=PSXDP_"^"_PSXLDP
34 Q
35LOOP1 S PSXNVP="" F S PSXNVP=$O(^TMP($J,"PSXVP",PSXNVP)) Q:PSXNVP="" S PSXFLG=1 D LOOP2
36 Q
37LOOP2 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
38 Q
39WRITE D:$Y>PSXPGLNG TITLE W:PSXFLG !,PSXNVP,?55,PSXNDP S PSXFLG=0 W !,?5,PSXAME,?60,PSXLLDP,!
40 Q
Note: See TracBrowser for help on using the repository browser.