source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJPDV.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1PSJPDV ;BIR/KKA-LIST PATIENTS ON SPECIFIC DRUGS ;01 Mar 99 / 3:18 PM
2 ;;5.0; INPATIENT MEDICATIONS ;**9,22,30,50,67**;16 DEC 97
3 ;
4 ; Reference to ^PS(50.7 is supported by DBIA# 2180.
5 ; Reference to ^PS(52.6 is supported by DBIA# 1231.
6 ; Reference to ^PS(52.7 is supported by DBIA# 2173.
7 ; Reference to ^PS(59.7 is supported by DBIA# 2181.
8 ; Reference to ^PSDRUG is supported by DBIA# 2192.
9 ; Reference to ^PS(50.606 is supported by DBIA# 2174.
10 ; Reference to ^PS(50.605 is supported by DBIA# 696.
11 ; Reference to ^%DT is supported by DBIA# 10003.
12 ; Reference to ^%ZISC is supported by DBIA# 10089.
13 ; Reference to ^DIC is supported by DBIA# 10006.
14 ; Reference to ^DIR is supported by DBIA# 10024.
15 ;
16DATES ;prompt user for the range of dates
17 W ! S %DT="ETX",D="start" D DT G:Y'>0 DONE S (%DT(0),PSJREPS)=+Y,D="stop" D DT K %DT G:Y'>0 DONE S:'$P(PSJREPS,".",2) PSJREPS=PSJREPS+.0001 S PSJREPF=Y+$S($P(Y,".",2):0,1:.24)
18 ;
19ORDERS D LIST^PSJEXP0 G:$D(OUT) DONE W !
20 ;
21SORT S DIR(0)="SAOM^P:Patient;S:Start Date",DIR("A")="Do you wish to sort by (P)atient or (S)tart Date: ",DIR("B")="Patient"
22 S DIR("?",1)="Enter a ""P"" if you wish to sort by patient name or enter ""S"" if you",DIR("?")="wish to sort by order start date." D ^DIR K DIR S PSJSRT=Y G:$D(DTOUT)!($D(DUOUT)) DONE
23 ;
24SELECT W ! S DIR(0)="SAM^O:Orderable Item;D:Dispense Drug;V:VA Class of Drugs",DIR("A")="List by (O)rderable Item, (D)ispense Drug, or (V)A Class of Drugs: "
25 S DIR("?",1)="Enter a ""O"" if you wish to list all patients on a specific orderable item",DIR("?",2)="Enter a ""D"" if you wish to list all patients on a specific dispense drug,"
26 S DIR("?")="or enter a ""V"" if you wish to list all patients on a VA class of drugs." D ^DIR K DIR S PSJSL=Y G:$D(DTOUT)!($D(DUOUT)) DONE
27 ;
28DRGS S COUNT=1,BCNT=0 W !
29 ;/IV Identifier is no longer used after POE
30 ;/S PSJIDD=$P($G(^PS(59.7,1,31)),"^",2)
31 F K DIC S DIC=$S(PSJSL="O":50.7,PSJSL="D":50,PSJSL="V":50.605),DIC(0)="QEAMZ" Q:$D(OUT) D
32 .I PSJSL="O" D
33 ..;/S DIC("W")="W "" ""_$P(^PS(50.606,$P(^PS(50.7,+Y,0),""^"",2),0),""^"")_$S($P(^PS(50.7,+Y,0),""^"",3):"" ""_$G(PSJIDD),1:"""")_"
34 ..S DIC("W")="W "" ""_$P(^PS(50.606,$P(^PS(50.7,+Y,0),""^"",2),0),""^"")_"
35 ..S DIC("W")=DIC("W")_""" ""_$S($P(^PS(50.7,+Y,0),""^"",4):$E($P(^(0),""^"",4),4,5)_""-""_$E($P(^(0),""^"",4),6,7)_""-""_$E($P(^(0),""^"",4),2,3),1:"""")"
36 .D ^DIC K DIC S:$D(DTOUT)!($D(DUOUT)) QFLG=1 S:(+Y'>0) OUT=1 Q:+Y'>0 S IEN=+Y,NAME=$P(Y,U,2) D @PSJSL
37 ;***PSJCNT is set to the number of drugs or classes the user chooses
38 S PSJCNT=COUNT-1
39 ;G:$D(QFLG)!(PSJCNT=0) DONE
40 G:$D(QFLG)!(BCNT=0) DONE
41 ;
42MATCH ;**prompt user for the number of matches
43 W ! S DIR(0)="NAO^1:"_PSJCNT_":0",DIR("A")="Select number of matches: ",DIR("B")=PSJCNT
44 S DIR("?",1)="Enter the number of drugs that a user must be receiving to appear",DIR("?",2)="on the report.",DIR("?",3)="",DIR("?")="The number must be between 1 and "_PSJCNT
45 D ^DIR K DIR S PSJMAT=Y G:$D(DTOUT)!($D(DUOUT)) DONE
46 ;
47 ;
48DEV ; ask print device and queue if asked to
49 K ZTSAVE S PSGTIR="ENQ^PSJPDV0",ZTDESC="List Patients on Specific Drugs" F X="CHOICE","PSJISP(","PSJSNM(","PSJREPS","PSJREPF","PSJSL","PSJSRT","PSJCNT","PSJMAT" S ZTSAVE(X)=""
50 D ENDEV^PSGTI I POP!$D(ZTSK) W:POP !!?3,"No device selected for report run." W:$D(ZTSK) !?3,"Report Queued!" K ZTSK G DONE
51 U IO
52 W:$E(IOST)="C" !,"...this may take a few minutes...",!?25,"...you really should QUEUE this report, if possible..."
53 D ^PSJPDV0
54 I '$D(QFLG)&($E(IOST)="C") W !!,"Press RETURN to continue: " R CONT:DTIME
55 ;
56DONE W:$E(IOST)="P" @IOF D ^%ZISC K %DT,CHOICE,CNT,CONT,COUNT,D,DIC,DTOUT,DUOUT,IEN,NAME,OUT,POP,PRIM,PSGP,PSGTIR,PSJCNT,PSJISP,PSJMAT,PSJREPF,PSJREPS,PSJSL,PSJSNM,PSJSRT,QFLG,SPDRG,X,Y
57 ;/K GG,GGG,MATCHES,ON,OUT,PSIVUP,PSJACNWP,PSJIDD,PSJORIFN,PSJPAD,PSJPAGE,PSJPBID,PSJPCAF,PSJPDD,PSJDOB,PSJPDX,PSJPHT,PSJPHTD,PSJPPID,PSJPRB,PSJPSEX,PSJPSSN,PSJPTD,PSJPTS,PSJPTSD,PSJPWD,PSJPWDN,PSJPWT,PSJPWTD,PSJPDOB,PSJPTSP
58 K GG,GGG,MATCHES,ON,OUT,PSIVUP,PSJACNWP,PSJORIFN,PSJPAD,PSJPAGE,PSJPBID,PSJPCAF,PSJPDD,PSJDOB,PSJPDX,PSJPHT,PSJPHTD,PSJPPID,PSJPRB,PSJPSEX,PSJPSSN,PSJPTD,PSJPTS,PSJPTSD,PSJPWD,PSJPWDN,PSJPWT,PSJPWTD,PSJPDOB,PSJPTSP
59 Q
60 ;
61P ;get primary drug from user
62 W !!,"Dispense Drugs for ",NAME," are:"
63 S SPDRG=0 F S SPDRG=$O(^PSDRUG("AP",IEN,SPDRG)) Q:'SPDRG W !,$P(^PSDRUG(SPDRG,0),"^") S PSJISP(SPDRG_"D")=COUNT_NAME,PSJSNM(NAME)=""
64 I $D(PSJSNM(NAME)) S (COUNT,BCNT)=COUNT+1
65 E W !," NONE FOUND"
66 W ! Q
67 ;
68O ;get orderable item from user
69 ;/I $P($G(^PS(50.7,IEN,0)),"^",3) S PSJIDD=$P($G(^PS(59.7,1,31)),"^",2) D O1 Q
70 NEW FIL F FIL=52.6,52.7 I $O(^PS(FIL,"AOI",IEN,0)) D O1 Q
71 W !!,"Dispense Drugs for ",NAME," are:"
72 S SPDRG=0 F S SPDRG=$O(^PSDRUG("ASP",IEN,SPDRG)) Q:'SPDRG W !,$P(^PSDRUG(SPDRG,0),"^") S PSJISP(SPDRG_"D")=COUNT_NAME,PSJSNM(NAME)=""
73 I $D(PSJSNM(NAME)) S (COUNT,BCNT)=COUNT+1
74 E W !," NONE FOUND"
75 W ! Q
76O1 ; here if the orderable item is marked for IV use
77 W !!,"Additives for ",NAME," are:"
78 ;/S SPDRG=0 F S SPDRG=$O(^PS(52.6,"AOI",IEN,SPDRG)) Q:'SPDRG W !,$P(^PS(52.6,SPDRG,0),"^") S PSJISP(IEN_"O")=COUNT_NAME,PSJSNM(NAME_" "_PSJIDD)=""
79 S SPDRG=0 F S SPDRG=$O(^PS(52.6,"AOI",IEN,SPDRG)) Q:'SPDRG W !,$P(^PS(52.6,SPDRG,0),"^") S PSJISP(IEN_"O")=COUNT_NAME,PSJSNM(NAME)=""
80 ;/I $D(PSJSNM(NAME_" "_PSJIDD)) S (COUNT,BCNT)=COUNT+1
81 I $D(PSJSNM(NAME)) S (COUNT,BCNT)=COUNT+1
82 E W !," NONE FOUND" D
83 .W !!,"Solutions for ",NAME," are:"
84 .;/S SPDRG=0 F S SPDRG=$O(^PS(52.7,"AOI",IEN,SPDRG)) Q:'SPDRG W !,$P(^PS(52.7,SPDRG,0),"^") S PSJISP(IEN_"O")=COUNT_NAME,PSJSNM(NAME_" "_PSJIDD)=""
85 .S SPDRG=0 F S SPDRG=$O(^PS(52.7,"AOI",IEN,SPDRG)) Q:'SPDRG W !,$P(^PS(52.7,SPDRG,0),"^") S PSJISP(IEN_"O")=COUNT_NAME,PSJSNM(NAME)=""
86 .;/I $D(PSJSNM(NAME_" "_PSJIDD)) S (COUNT,BCNT)=COUNT+1
87 .I $D(PSJSNM(NAME)) S (COUNT,BCNT)=COUNT+1
88 .E W !," NONE FOUND"
89 W ! Q
90 ;
91D ;get dispense drug from user
92 S PSJISP(IEN_"D")=COUNT,(BCNT,COUNT)=COUNT+1,PSJSNM(NAME)=""
93 Q
94 ;
95V ;get VA Class of Drug from user
96 W !!,"Dispense Drugs for VA Class ",NAME," are: "
97 S PRIM=0 F S PRIM=$O(^PSDRUG("AOC",PRIM)) Q:'PRIM S SPDRG=0 F S SPDRG=$O(^PSDRUG("AOC",PRIM,NAME,SPDRG)) Q:'SPDRG W !,$P(^PSDRUG(SPDRG,0),"^") S PSJISP(SPDRG_"D")=COUNT_NAME,PSJSNM(NAME)=""
98 I $D(PSJSNM(NAME)) S (BCNT,COUNT)=COUNT+1
99 W ! Q
100 ;
101DT S Y=-1 F W !!,"Enter ",D," date: " R X:DTIME W:'$T $C(7) S:'$T X="^" D DTM:X?1."?",^%DT:"^"'[X I Y>0!("^"[X) W:Y<0 !,"No ",D," date chosen for notices run." Q
102 Q
103DTM W !!,"Enter the ",D," date of the range of dates where you wish to see patients ",!,"on specific drugs. The start date and stop date may be the same." W:D="stop" " The stop",!,"date may not come before the start date." W ! Q
Note: See TracBrowser for help on using the repository browser.