source: FOIAVistA/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSUTLPZ.m@ 1783

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

initial load of FOIAVistA 6/30/08 version

File size: 7.4 KB
Line 
1PSSUTLPZ ;BIR/RTR-Pre release report utility routine ;02/14/00
2 ;;1.0;PHARMACY DATA MANAGEMENT;**40**;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
38 K DIE S DA(1)=PSSDOSE,DA=PSSNOUN,DR=".01;1;2",DIE="^PS(50.606,"_PSSDOSE_",""NOUN""," D ^DIE K DIE G:'$D(Y)&('$D(DTOUT)) NOUNA
39NOUNC W ! K DIE S DA=PSSDOSE,DIE="^PS(50.606,",DR="10" D ^DIE K DIE G NOUN
40NOUNQ W ! K DIC,DR,DIE,PSSDOSE,PSSNOUN
41 Q
42CHECK ;Check for running conversion
43 S PSSNOCON=0
44 S PSSYSIEN=$O(^PS(59.7,0))
45 I $P($G(^PS(59.7,+$G(PSSYSIEN),80)),"^",3)=2 S PSSNOCON=1
46 K PSSYSIEN I PSSNOCON W $C(7) W !!,"Cannot use this option, Dosage conversion is currently running!",!
47 Q
48TRAC ;
49 N PSZZ,PSZZ1,PSZZ2,PSZSTA,PSZSTO,PSZWHO
50 S PSZZ1=$O(^PS(59.7,0)),PSZZ2=$P($G(^PS(59.7,+$G(PSZZ1),80)),"^",3)
51 I PSZZ2 D
52 .S Y=$P($G(^PS(59.7,+$G(PSZZ1),80)),"^",4) I Y D DD^%DT S PSZSTA=$G(Y)
53 .S Y=$P($G(^PS(59.7,+$G(PSZZ1),80)),"^",5) I Y D DD^%DT S PSZSTO=$G(Y)
54 .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
55 H 1 W @IOF W !,?15,"Dosage Conversion Tracker Status",! F PSZZ=1:1:77 W "="
56 I 'PSZZ2 W !,"The Dosage conversion has never been run!",! G TRACQ
57 I PSZZ2=1 W !,"The Dosage conversion is queued to run at "_$G(PSZSTA),!,"It was queued by "_$G(PSZWHO),! G TRACQ
58 I PSZZ2=2 W !,"The Dosage conversion is currently running.",!,"It started at "_$G(PSZSTA),! G TRACQ
59 I PSZZ2=3 W !,"The Dosage conversion was last run by "_$G(PSZWHO),!,"It started on "_$G(PSZSTA)_" and ended on "_$G(PSZSTO),!
60TRACQ W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR W ! K DIR
61 Q
62FRE ;
63 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
64 K DIE W ! S DA=+Y,DIE="^PS(51,",DR="31" D ^DIE G:$D(Y)!($D(DTOUT)) FREQ
65 G FRE
66FREQ W ! K DA,DIE,DR,DIC
67 Q
68FRRP ;
69 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.",!
70 K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I $G(POP) W !!,"Nothing queued to print.",!! Q
71 I $D(IO("Q")) S ZTRTN="ENF^PSSUTLPR",ZTDESC="Med Instruction Frequency report" D ^%ZTLOAD K %ZIS W !,"Report queued to print." Q
72ENF ;
73 U IO
74 S PSSOUT=0,PSSDV=$S($E(IOST)="C":"C",1:"P"),PSSCT=1
75 K PSSLINE,PSSF,PSSFR S $P(PSSLINE,"-",79)=""
76 D ENFH
77 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
78 .I ($Y+5)>IOSL D ENFH Q:$G(PSSOUT)
79 .S PSSFNODE=$G(^PS(51,PSSFR,0)) Q:PSSFNODE=""
80 .W !,$P(PSSFNODE,"^"),?11,$P(PSSFNODE,"^",3),?22,$P(PSSFNODE,"^",8),?30,$P(PSSFNODE,"^",2)
81 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
82 I $G(PSSDV)="C" W !
83 E W @IOF
84 K PSSLINE,PSSOUT,PSSF,PSSFR,PSSCT,PSSDV D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
85 Q
86ENFH ;
87 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
88 W @IOF W !?5,"MEDICATION INSTRUCTION FREQUENCY REPORT"_$S($G(PSSCT)=1:"",1:" (cont.)"),?68,"PAGE: "_$G(PSSCT) S PSSCT=PSSCT+1
89 W !!,"NAME",?10,"SYNONYM",?21,"FREQUENCY",?34,"EXPANSION",!,PSSLINE,!
90 Q
91SLS ;Called from PSSORUTL
92 K PSSJZUNT
93 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
94 N PSSJ,PSSJ1,PSSJ2,PSSI,PSSJA,PSSJA1,PSSJB,PSSJB1,PSSWZI,PSSWZSL,PSSWZND,PSSWZSL1,PSSWZSL2,PSSWZSL3,PSSWZSL4,PSSWZSL5,PSSWZ50
95 S PSSJ=$P($G(PSSX(PSSA,PL3)),"^"),PSSI=$P($G(PSSX(PSSA,PL3)),"^",2)
96 S PSSWZSL=0,PSSWZI=+$P($G(PSSX(PSSA,PL3)),"^",6),PSSWZ50=$P($G(^PSDRUG(PSSWZI,"DOS")),"^")
97 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
98 S PSSJA=$P(PSSI,"/"),PSSJB=$P(PSSI,"/",2),PSSJA1=+$G(PSSJA),PSSJB1=+$G(PSSJB)
99 I '$G(PSSWZND) S $P(PSSX(PSSA,PL3),"^",5)=$P(PSSX(PSSA,PL3),"^") G SLSQ
100 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))
101 S PSSJ2=$S('$G(PSSJA1):PSSJ,1:($G(PSSJA1)*PSSJ))_$S($G(PSSJA1):$P(PSSJA,PSSJA1,2),1:PSSJA)_"/"_$G(PSSWZSL5)
102 S PSSJZUNT=$P(PSSI,"/")_"/"_$G(PSSWZSL4)_$S('$G(PSSJB1):$G(PSSJB),1:$P(PSSJB,PSSJB1,2)) S $P(PSSX(PSSA,PL3),"^",2)=PSSJZUNT
103 S $P(PSSX(PSSA,PL3),"^",5)=PSSJ2
104SLSQ Q
105 ;
106ADDRP ;
107 D ^DIR K DIR S PSSTYPE=Y I Y["^"!($D(DIRUT)) K PSSTYPE W ! Q
108 W !!?3,"*** THIS REPORT IS DESIGNED FOR 132 COLUMNS ***",!
109 K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I $G(POP) W !,"Nothing queued to print.",! K PSSTYPE W ! Q
110 I '$G(DT) S DT=$$DT^XLFDT
111 S X1=DT,X2=-365 D C^%DTC S PSSYRX=$G(X) K X,X1,X2
112 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
113 G ADD^PSSREMCH
Note: See TracBrowser for help on using the repository browser.