source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSMATCH.m@ 1259

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

initial load of WorldVistAEHR

File size: 5.2 KB
Line 
1PSSMATCH ;BIR/RTR-Reports for Orderable Items ; 09/02/97 8:40
2 ;;1.0;PHARMACY DATA MANAGEMENT;;9/30/97
3PRI D CPK G:$G(PSSITEQT) CPK1 W !,"These reports are based on creating your Orderable Item file by Primary Name,",!,"then by VA Generic Name." S VAONLY=0 G DIR
4VA D CPK G:$G(PSSITEQT) CPK1 W !,"There reports are based on creating your Orderable Item File by VA Generic Name." S VAONLY=1
5DIR K DIR S DIR(0)="S^M:Drugs that will match;C:Drugs that can't be matched",DIR("A",1)="Enter M for Orderable Items that will auto-create,",DIR("A",2)="which includes Dispense Drugs, Additives, and Solutions that will match."
6 S DIR("A",3)="Enter C for the report of Dispense Drugs that can't auto-match.",DIR("A",4)="",DIR("A")="Enter M or C" D ^DIR K DIR
7 G:Y["^"!($D(DUOUT))!($D(DTOUT)) END
8 S PSMATCH=$S(Y="M":1,1:0)
9 W $C(7),!!,"**WARNING** THIS REPORT MAY BE VERY LONG!"
10 D RMES^PSSPOIM1
11QUE W ! K %ZIS,IOP,ZTSK S %ZIS("B")="",%ZIS="QM" D ^%ZIS I POP G END
12 I $E(IOST)["C"!('$D(IO("Q"))) W $C(7),!?5,"This report must be QUEUED to a printer, enter Q at Device prompt!",! G QUE
13 S ZTRTN="BEG^PSSMATCH",ZTDESC="Orderable Item Reports",ZTSAVE("PSMATCH")="",ZTSAVE("VAONLY")="" D ^%ZTLOAD K IO("Q")
14END K ^TMP("PSSD",$J),^TMP("PSS",$J),^TMP("PSSADD",$J),^TMP("PSSOL",$J),AAA,BBB,DIR,DOSEFORM,EEE,GFLAG,GGG,LINE,LLL,PAGE,PSMATCH,PSODD,PSOIV,PSOLU,REASON,ANM,AVL,SSS,TTT,VAONLY,VARONE,VARTWO,ZFLAG,ZZZ D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
15BEG S SSITE=$O(^PS(59.7,0)),SITEADD=$S($P($G(^PS(59.7,+SSITE,31)),"^",2)'="":$P(^(31),"^",2),1:"IV") K SSITE
16 G:'PSMATCH CANT
17 D ^PSSSPD I VAONLY K ^TMP("PSSD",$J),^TMP("PSS",$J),^TMP("PSSADD",$J,"ZZZZ"),^TMP("PSSOL",$J,"ZZZZ") G PASS
18 K ^TMP("PSSD",$J,"ZZZZ"),^TMP("PSSADD",$J,"ZZZZ"),^TMP("PSSOL",$J,"ZZZZ")
19PASS D:VAONLY BEG^PSSPOIM D:'VAONLY BEG^PSSPOIC
20 K LINE S $P(LINE,"-",79)="",PAGE=1,(ZFLAG,GFLAG)=0
21 D ADD
22 D SOL
23 S PAGE=1 D HEAD
24 S ZZZ="" F S ZZZ=$O(^TMP("PSSD",$J,ZZZ)) Q:ZZZ="" S:($Y+6)>IOSL ZFLAG=1 D:ZFLAG HEAD W:'ZFLAG !,LINE,!,ZZZ S ZFLAG=0 S GGG="" F S GGG=$O(^TMP("PSSD",$J,ZZZ,GGG)) Q:GGG="" D
25 .S:($Y+4)>IOSL GFLAG=1 D:GFLAG HEAD W !,?2,GGG," ",$S(^TMP("PSSD",$J,ZZZ,GGG)'="":"("_$E($P(^(GGG),"^"),1,33)_")",1:"")
26 W @IOF G END
27HEAD W @IOF
28 I $G(VAONLY) W !,?2,"ORDERABLE ITEMS - MATCHES BY VA GENERIC NAME ONLY PAGE ",PAGE
29 I '$G(VAONLY) W !,?2,"ORDERABLE ITEMS - MATCHES BY PRIMARY NAME THEN VA GENERIC NAME PAGE ",PAGE,!?4,"(PRIMARY DRUG) IN PARENTHESIS"
30 W !,LINE S PAGE=PAGE+1
31 I ZFLAG W !!,ZZZ Q
32 I GFLAG W !!,ZZZ," (cont.)"
33 S GFLAG=0 Q
34ADD ;
35 D ADHEAD
36 S AAA="" F S AAA=$O(^TMP("PSSADD",$J,AAA)) Q:AAA="" S VARTWO="",PSODD=$O(^TMP("PSSADD",$J,AAA,VARTWO)) S DOSEFORM=^(PSODD) D
37 .D:($Y+5)>IOSL ADHEAD W !,AAA," ",SITEADD,!?3,PSODD," ",DOSEFORM,!,LINE
38 W @IOF Q
39ADHEAD W @IOF W !?2,"ORDERABLE ITEM (ADDITIVE) IV FLAG",?69,"PAGE ",PAGE,!," DISPENSE DRUG DOSE FORM",!,LINE S PAGE=PAGE+1
40 Q
41SOL ;
42 S PAGE=1,(GFLAG,ZFLAG)=0 D SOLHEAD
43 S FFF="" F S FFF=$O(^TMP("PSSOL",$J,FFF)) Q:FFF="" S ZZZ="" F S ZZZ=$O(^TMP("PSSOL",$J,FFF,ZZZ)) Q:ZZZ="" D
44 .S:($Y+6)>IOSL ZFLAG=1 D:ZFLAG SOLHEAD W:'ZFLAG !,LINE,!,FFF," ",ZZZ S ZFLAG=0 S WWW="" F S WWW=$O(^TMP("PSSOL",$J,FFF,ZZZ,WWW)) Q:WWW="" D
45 ..S:($Y+4)>IOSL GFLAG=1 D:GFLAG SOLHEAD W !?2,FFF," ",$P($G(^PS(52.7,+^TMP("PSSOL",$J,FFF,ZZZ,WWW),0)),"^",3)
46 W @IOF Q
47SOLHEAD W @IOF W !?2,"ORDERABLE ITEM (SOLUTION) DOSE FORM",?69,"PAGE ",PAGE,!," SOLUTION VOLUME",!,LINE S PAGE=PAGE+1
48 I ZFLAG W !!,FFF," ",ZZZ Q
49 I GFLAG W !!,FFF," ",ZZZ," (cont.)"
50 S GFLAG=0 Q
51CANT ;
52 D ^PSSSPD I VAONLY K ^TMP("PSSD",$J),^TMP("PSS",$J)
53SKIP D:VAONLY CANT^PSSPOIM D:'VAONLY CANT^PSSPOIC
54 K LINE S $P(LINE,"-",79)="",PAGE=1,(ZFLAG,GFLAG)=0
55 D ADDCANT
56 D SOLCANT
57NO S PAGE=1 D NOHEAD
58 S EEE="" F S EEE=$O(^TMP("PSSD",$J,"ZZZZ",EEE)) Q:EEE="" S REASON=^(EEE) D:($Y+5)>IOSL NOHEAD W !,EEE,?43,REASON D:($O(^(EEE,0))) W !,LINE
59 .F TTT=0:0 S TTT=$O(^TMP("PSSD",$J,"ZZZZ",EEE,TTT)) Q:'TTT S:($Y+5)>IOSL ZFLAG=1 D:($Y+5)>IOSL NOHEAD W !?3,^(TTT)
60 W @IOF G END
61NOHEAD W @IOF W !,?2,$S($G(VAONLY):"ORDERABLE ITEMS - VA GENERIC NAME ONLY, CAN'T MATCH",1:"ORDERABLE ITEMS - PRIMARY NAME THEN VA GENERIC NAME, CAN'T MATCH"),?69,"PAGE ",PAGE,!,LINE S PAGE=PAGE+1
62 I ZFLAG W !,EEE,?43,REASON S ZFLAG=0
63 Q
64ADDCANT ;
65 D HEADA
66 S BBB="" F S BBB=$O(^TMP("PSSADD",$J,"ZZZZ",BBB)) Q:BBB="" S REASON=^(BBB),ANM=$O(^PSDRUG("B",BBB,0)) Q:'ANM D Q:ANM="" D:($Y+5)>IOSL HEADA W !,ANM,?43,$G(REASON),!,LINE
67 .S ANM=$O(^PS(52.6,"AC",ANM,0)),ANM=$P($G(^PS(52.6,+$G(ANM),0)),"^")
68 W @IOF Q
69HEADA W @IOF W !?2,"ORDERABLE ITEMS - ADDITIVES THAT CANNOT AUTO MATCH",?69,"PAGE ",PAGE,!,LINE S PAGE=PAGE+1
70 Q
71SOLCANT ;
72 S PAGE=1 D HEADS
73 S LLL="" F S LLL=$O(^TMP("PSSOL",$J,"ZZZZ",LLL)) Q:LLL="" S REASON=^(LLL),ANM=$O(^PSDRUG("B",LLL,0)) Q:'ANM D Q:ANM="" D:($Y+6)>IOSL HEADS W !,ANM,?43,AVL,!?5,$G(REASON),!,LINE
74 .S ANM=$O(^PS(52.7,"AC",ANM,0)),AVL=$P($G(^PS(52.7,+$G(ANM),0)),"^",3),ANM=$P($G(^PS(52.7,+$G(ANM),0)),"^")
75 W @IOF Q
76HEADS W @IOF W !?2,"ORDERABLE ITEMS - SOLUTIONS THAT CANNOT AUTO MATCH",?69,"PAGE ",PAGE,!,LINE S PAGE=PAGE+1
77 Q
78CPK S PSSITE=+$O(^PS(59.7,0)) I +$P($G(^PS(59.7,PSSITE,80)),"^",2)>1 W !!,"The Orderable Item auto-create has already run to completion!",! S PSSITEQT=1 K DIR S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR
79 Q
80CPK1 K PSSITEQT Q
Note: See TracBrowser for help on using the repository browser.