source: FOIAVistA/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSUTLPR.m

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

initial load of FOIAVistA 6/30/08 version

File size: 7.5 KB
Line 
1PSSUTLPR ;BIR/RTR-Pre release utility routine ;02/14/00
2 ;;1.0;PHARMACY DATA MANAGEMENT;**34,47**;9/30/97
3 ;
4TEXT ;Text for pre-release report
5 W !!,"The current Orderable Item structure keeps Additives and Solutions matched to",!,"Orderable Items flagged for IV use. All Dispense Drugs are currently matched to",!,"Orderable Items that are not flagged for IV Use. This was done"
6 W " to control "
7 W !,"the finishing process of IV and Unit Dose orders entered through CPRS.",!,"The new Orderable Item structure will inactivate all IV flagged Orderable",!,"Items. All Additives and Solutions will be re-matched to non-IV flagged"
8 W !,"Orderable Items, based on their Dispense Drug links.",!
9 W ! K DIR S DIR(0)="E" D ^DIR K DIR I Y["^"!($D(DIRUT)) K Y S PSSOUT=1 Q
10 K PSSTYPE
11 K DIR S DIR(0)="S^A:ADDITIVES;S:SOLUTIONS;B:BOTH",DIR("A")="Print report for Additives, Solutions, or Both",DIR("B")="B"
12 S DIR("?")=" ",DIR("?",1)="Enter 'A' to see how the Additives will be re-matched in the new Orderable"
13 S DIR("?",2)="Item structure, enter 'S' to see how the Solutions will be re-matched in the",DIR("?",3)="new Orderable Item structure, enter 'B' to see both, enter '^' to exit."
14 Q
15INS ;Convert non-numeric Instructions to Nouns
16 D CHECK I $G(PSSNOCON) K PSSNOCON Q
17 K PSSNOCON
18 W !!,"This option will move all non-numeric Instructions to the Noun field in the",!,"Dosage Form file. If you do this, you will then need to review the Nouns and decide to mark them for Inpatient, Outpatient or both."
19 W ! K DIR S DIR(0)="Y",DIR("A")="Convert all non-numeric Instructions to Nouns",DIR("B")="Y" D ^DIR I Y'=1 W !!,"Nothing converted.",! G INSQ
20 W !,"Converting.." H 1
21 N PSSD,PSSI,PSSINS
22 F PSSD=0:0 S PSSD=$O(^PS(50.606,PSSD)) Q:'PSSD D:$O(^PS(50.606,PSSD,"INS",0))
23 .F PSSI=0:0 S PSSI=$O(^PS(50.606,PSSD,"INS",PSSI)) Q:'PSSI S PSSINS=$P($G(^PS(50.606,PSSD,"INS",PSSI,0)),"^") I PSSINS'="" D
24 ..I PSSINS?.N!(PSSINS?.N1".".N) Q
25 ..I $O(^PS(50.606,PSSD,"NOUN","B",PSSINS,0)) Q
26 ..K DIC,DD,DO S DA(1)=PSSD,DIC="^PS(50.606,"_DA(1)_",""NOUN"",",DIC(0)="L",X=PSSINS D FILE^DICN W "." K DD,DO,DIC
27 W !,"Finished converting Instructions to Nouns!"
28INSQ W !
29 Q
30NOUN ;Enter/edit Nouns
31 D CHECK I $G(PSSNOCON) K PSSNOCON G NOUNQ
32 K PSSNOCON
33 W ! K DIC S DIC(0)="QEAMZ",DIC="^PS(50.606," D ^DIC I Y<1!($D(DTOUT))!($D(DUOUT)) G NOUNQ
34 S PSSDOSE=+Y
35NOUNA W !!?2,"Dosage Form => ",$P($G(^PS(50.606,+PSSDOSE,0)),"^"),! K DIC S DA(1)=PSSDOSE,DIC="^PS(50.606,"_PSSDOSE_",""NOUN"",",DIC(0)="QEAMLZ" D D ^DIC I Y<1!($D(DUOUT))!($D(DTOUT)) G NOUNC
36 .S DIC("W")="W "" ""_$P($G(^PS(50.606,PSSDOSE,""NOUN"",+Y,0)),""^"",2)"
37 S PSSNOUN=+Y,PSSOTH=$S($P($G(^PS(59.7,1,40.2)),"^"):1,1:0)
38 K DIE S DA(1)=PSSDOSE,DA=PSSNOUN,DR=".01;S:'$G(PSSOTH) Y=""@1"";3;@1;1;2",DIE="^PS(50.606,"_PSSDOSE_",""NOUN"","
39 D ^DIE K DIE,PSSOTH G:'$D(Y)&('$D(DTOUT)) NOUNA
40NOUNC W ! K DIE,PSSOTH S DA=PSSDOSE,DIE="^PS(50.606,",DR="10" D ^DIE K DIE G NOUN
41NOUNQ W ! K DIC,DR,DIE,PSSDOSE,PSSNOUN,PSSOTH
42 Q
43CHECK ;Check for running conversion
44 S PSSNOCON=0
45 S PSSYSIEN=$O(^PS(59.7,0))
46 I $P($G(^PS(59.7,+$G(PSSYSIEN),80)),"^",3)=2 S PSSNOCON=1
47 K PSSYSIEN I PSSNOCON W $C(7) W !!,"Cannot use this option, Dosage conversion is currently running!",!
48 Q
49TRAC ;
50 N PSZZ,PSZZ1,PSZZ2,PSZSTA,PSZSTO,PSZWHO
51 S PSZZ1=$O(^PS(59.7,0)),PSZZ2=$P($G(^PS(59.7,+$G(PSZZ1),80)),"^",3)
52 I PSZZ2 D
53 .S Y=$P($G(^PS(59.7,+$G(PSZZ1),80)),"^",4) I Y D DD^%DT S PSZSTA=$G(Y)
54 .S Y=$P($G(^PS(59.7,+$G(PSZZ1),80)),"^",5) I Y D DD^%DT S PSZSTO=$G(Y)
55 .K PSZWHOAR S DA=+$P($G(^PS(59.7,+$G(PSZZ1),80)),"^",6) I DA S DIC=200,DR=".01",DIQ(0)="E",DIQ="PSZWHOAR" D EN^DIQ1 S PSZWHO=$G(PSZWHOAR(200,DA,.01,"E")) K DIQ,PSZWHOAR,DR,DIC,DA
56 H 1 W @IOF W !,?15,"Dosage Conversion Tracker Status",! F PSZZ=1:1:77 W "="
57 I 'PSZZ2 W !,"The Dosage conversion has never been run!",! G TRACQ
58 I PSZZ2=1 W !,"The Dosage conversion is queued to run at "_$G(PSZSTA),!,"It was queued by "_$G(PSZWHO),! G TRACQ
59 I PSZZ2=2 W !,"The Dosage conversion is currently running.",!,"It started at "_$G(PSZSTA),! G TRACQ
60 I PSZZ2=3 W !,"The Dosage conversion was last run by "_$G(PSZWHO),!,"It started on "_$G(PSZSTA)_" and ended on "_$G(PSZSTO),!
61TRACQ W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR W ! K DIR
62 Q
63FRE ;
64 W ! K DIC S DIC(0)="QEAMZ",DIC("A")="Select Medication Instruction: ",DIC="^PS(51," D ^DIC K DIC I Y<1!($D(DTOUT))!($D(DUOUT)) G FREQ
65 K DIE W ! S DA=+Y,DIE="^PS(51,",DR="31" D ^DIE G:$D(Y)!($D(DTOUT)) FREQ
66 G FRE
67FREQ W ! K DA,DIE,DR,DIC
68 Q
69FRRP ;
70 W !!,"This report shows the MEDICATION INSTRUCTION file entries, along with the",!,"Synonym, Frequency and Expansion. Use the Edit Medication Instruction",!,"Frequency option to enter appropriate frequencies.",!
71 K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I $G(POP) W !!,"Nothing queued to print.",!! Q
72 I $D(IO("Q")) S ZTRTN="ENF^PSSUTLPR",ZTDESC="Med Instruction Frequency report" D ^%ZTLOAD K %ZIS W !,"Report queued to print." Q
73ENF ;
74 U IO
75 S PSSOUT=0,PSSDV=$S($E(IOST)="C":"C",1:"P"),PSSCT=1
76 K PSSLINE,PSSF,PSSFR S $P(PSSLINE,"-",79)=""
77 D ENFH
78 S PSSF="" F S PSSF=$O(^PS(51,"B",PSSF)) Q:PSSF=""!($G(PSSOUT)) F PSSFR=0:0 S PSSFR=$O(^PS(51,"B",PSSF,PSSFR)) Q:'PSSFR!($G(PSSOUT)) I $G(^PS(51,"B",PSSF,PSSFR))="" D
79 .I ($Y+5)>IOSL D ENFH Q:$G(PSSOUT)
80 .S PSSFNODE=$G(^PS(51,PSSFR,0)) Q:PSSFNODE=""
81 .W !,$P(PSSFNODE,"^"),?11,$P(PSSFNODE,"^",3),?22,$P(PSSFNODE,"^",8),?30,$P(PSSFNODE,"^",2)
82 I '$G(PSSOUT),$G(PSSDV)="C" W !!,"End of Report." K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
83 I $G(PSSDV)="C" W !
84 E W @IOF
85 K PSSLINE,PSSOUT,PSSF,PSSFR,PSSCT,PSSDV D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
86 Q
87ENFH ;
88 I $G(PSSDV)="C",$G(PSSCT)'=1 W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSOUT=1 Q
89 W @IOF W !?5,"MEDICATION INSTRUCTION FREQUENCY REPORT"_$S($G(PSSCT)=1:"",1:" (cont.)"),?68,"PAGE: "_$G(PSSCT) S PSSCT=PSSCT+1
90 W !!,"NAME",?10,"SYNONYM",?21,"FREQUENCY",?34,"EXPANSION",!,PSSLINE,!
91 Q
92SLS ;Called from PSSORUTL
93 K PSSJZUNT
94 I $P($G(PSSX(PSSA,PL3)),"^",2)'["/" S $P(PSSX(PSSA,PL3),"^",5)=$P($G(PSSX(PSSA,PL3)),"^")_$P($G(PSSX(PSSA,PL3)),"^",2) Q
95 N PSSJ,PSSJ1,PSSJ2,PSSI,PSSJA,PSSJA1,PSSJB,PSSJB1,PSSWZI,PSSWZSL,PSSWZND,PSSWZSL1,PSSWZSL2,PSSWZSL3,PSSWZSL4,PSSWZSL5,PSSWZ50
96 S PSSJ=$P($G(PSSX(PSSA,PL3)),"^"),PSSI=$P($G(PSSX(PSSA,PL3)),"^",2)
97 S PSSWZSL=0,PSSWZI=+$P($G(PSSX(PSSA,PL3)),"^",6),PSSWZ50=$P($G(^PSDRUG(PSSWZI,"DOS")),"^")
98 S PSSWZND=$$PSJST^PSNAPIS(+$P($G(^PSDRUG(PSSWZI,"ND")),"^"),+$P($G(^PSDRUG(PSSWZI,"ND")),"^",3)) S PSSWZND=+$P($G(PSSWZND),"^",2) ;I $G(PSSWZND),$G(PSSWZ50),+$G(PSSWZND)'=+$G(PSSWZ50) S PSSWZSL=1
99 S PSSJA=$P(PSSI,"/"),PSSJB=$P(PSSI,"/",2),PSSJA1=+$G(PSSJA),PSSJB1=+$G(PSSJB)
100 I '$G(PSSWZND) S $P(PSSX(PSSA,PL3),"^",5)=$P(PSSX(PSSA,PL3),"^") G SLSQ
101 S PSSWZSL2=PSSWZ50/PSSWZND,PSSWZSL3=PSSWZSL2*+$P($G(PSSX(PSSA,PL3)),"^",3) S PSSWZSL4=PSSWZSL3*$S($G(PSSJB1):PSSJB1,1:1) S PSSWZSL5=$S('$G(PSSJB1):PSSWZSL4_$G(PSSJB),1:PSSWZSL4_$P(PSSJB,PSSJB1,2))
102 S PSSJ2=$S('$G(PSSJA1):PSSJ,1:($G(PSSJA1)*PSSJ))_$S($G(PSSJA1):$P(PSSJA,PSSJA1,2),1:PSSJA)_"/"_$G(PSSWZSL5)
103 S PSSJZUNT=$P(PSSI,"/")_"/"_$G(PSSWZSL4)_$S('$G(PSSJB1):$G(PSSJB),1:$P(PSSJB,PSSJB1,2)) S $P(PSSX(PSSA,PL3),"^",2)=PSSJZUNT
104 S $P(PSSX(PSSA,PL3),"^",5)=PSSJ2
105SLSQ Q
106 ;
107ADDRP ;
108 D ^DIR K DIR S PSSTYPE=Y I Y["^"!($D(DIRUT)) K PSSTYPE W ! Q
109 W !!?3,"*** THIS REPORT IS DESIGNED FOR 132 COLUMNS ***",!
110 K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I $G(POP) W !,"Nothing queued to print.",! K PSSTYPE W ! Q
111 I '$G(DT) S DT=$$DT^XLFDT
112 S X1=DT,X2=-365 D C^%DTC S PSSYRX=$G(X) K X,X1,X2
113 I $D(IO("Q")) S ZTRTN="ADD^PSSREMCH",ZTDESC="Orderable Item re-matching report",ZTSAVE("PSSTYPE")="",ZTSAVE("PSSYRX")="" D ^%ZTLOAD K %ZIS W !,"Report queued to print." G END^PSSREMCH
114 G ADD^PSSREMCH
Note: See TracBrowser for help on using the repository browser.