| [613] | 1 | PSJPDV ;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 | ;
|
|---|
| 16 | DATES ;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 | ;
|
|---|
| 19 | ORDERS D LIST^PSJEXP0 G:$D(OUT) DONE W !
|
|---|
| 20 | ;
|
|---|
| 21 | SORT 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 | ;
|
|---|
| 24 | SELECT 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 | ;
|
|---|
| 28 | DRGS 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 | ;
|
|---|
| 42 | MATCH ;**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 | ;
|
|---|
| 48 | DEV ; 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 | ;
|
|---|
| 56 | DONE 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 | ;
|
|---|
| 61 | P ;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 | ;
|
|---|
| 68 | O ;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
|
|---|
| 76 | O1 ; 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 | ;
|
|---|
| 91 | D ;get dispense drug from user
|
|---|
| 92 | S PSJISP(IEN_"D")=COUNT,(BCNT,COUNT)=COUNT+1,PSJSNM(NAME)=""
|
|---|
| 93 | Q
|
|---|
| 94 | ;
|
|---|
| 95 | V ;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 | ;
|
|---|
| 101 | DT 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
|
|---|
| 103 | DTM 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
|
|---|
