81 lines
5.2 KiB
Mathematica
81 lines
5.2 KiB
Mathematica
PSSMATCH ;BIR/RTR-Reports for Orderable Items ; 09/02/97 8:40
|
|
;;1.0;PHARMACY DATA MANAGEMENT;;9/30/97
|
|
PRI 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
|
|
VA D CPK G:$G(PSSITEQT) CPK1 W !,"There reports are based on creating your Orderable Item File by VA Generic Name." S VAONLY=1
|
|
DIR 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."
|
|
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
|
|
G:Y["^"!($D(DUOUT))!($D(DTOUT)) END
|
|
S PSMATCH=$S(Y="M":1,1:0)
|
|
W $C(7),!!,"**WARNING** THIS REPORT MAY BE VERY LONG!"
|
|
D RMES^PSSPOIM1
|
|
QUE W ! K %ZIS,IOP,ZTSK S %ZIS("B")="",%ZIS="QM" D ^%ZIS I POP G END
|
|
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
|
|
S ZTRTN="BEG^PSSMATCH",ZTDESC="Orderable Item Reports",ZTSAVE("PSMATCH")="",ZTSAVE("VAONLY")="" D ^%ZTLOAD K IO("Q")
|
|
END 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
|
|
BEG S SSITE=$O(^PS(59.7,0)),SITEADD=$S($P($G(^PS(59.7,+SSITE,31)),"^",2)'="":$P(^(31),"^",2),1:"IV") K SSITE
|
|
G:'PSMATCH CANT
|
|
D ^PSSSPD I VAONLY K ^TMP("PSSD",$J),^TMP("PSS",$J),^TMP("PSSADD",$J,"ZZZZ"),^TMP("PSSOL",$J,"ZZZZ") G PASS
|
|
K ^TMP("PSSD",$J,"ZZZZ"),^TMP("PSSADD",$J,"ZZZZ"),^TMP("PSSOL",$J,"ZZZZ")
|
|
PASS D:VAONLY BEG^PSSPOIM D:'VAONLY BEG^PSSPOIC
|
|
K LINE S $P(LINE,"-",79)="",PAGE=1,(ZFLAG,GFLAG)=0
|
|
D ADD
|
|
D SOL
|
|
S PAGE=1 D HEAD
|
|
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
|
|
.S:($Y+4)>IOSL GFLAG=1 D:GFLAG HEAD W !,?2,GGG," ",$S(^TMP("PSSD",$J,ZZZ,GGG)'="":"("_$E($P(^(GGG),"^"),1,33)_")",1:"")
|
|
W @IOF G END
|
|
HEAD W @IOF
|
|
I $G(VAONLY) W !,?2,"ORDERABLE ITEMS - MATCHES BY VA GENERIC NAME ONLY PAGE ",PAGE
|
|
I '$G(VAONLY) W !,?2,"ORDERABLE ITEMS - MATCHES BY PRIMARY NAME THEN VA GENERIC NAME PAGE ",PAGE,!?4,"(PRIMARY DRUG) IN PARENTHESIS"
|
|
W !,LINE S PAGE=PAGE+1
|
|
I ZFLAG W !!,ZZZ Q
|
|
I GFLAG W !!,ZZZ," (cont.)"
|
|
S GFLAG=0 Q
|
|
ADD ;
|
|
D ADHEAD
|
|
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
|
|
.D:($Y+5)>IOSL ADHEAD W !,AAA," ",SITEADD,!?3,PSODD," ",DOSEFORM,!,LINE
|
|
W @IOF Q
|
|
ADHEAD W @IOF W !?2,"ORDERABLE ITEM (ADDITIVE) IV FLAG",?69,"PAGE ",PAGE,!," DISPENSE DRUG DOSE FORM",!,LINE S PAGE=PAGE+1
|
|
Q
|
|
SOL ;
|
|
S PAGE=1,(GFLAG,ZFLAG)=0 D SOLHEAD
|
|
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
|
|
.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
|
|
..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)
|
|
W @IOF Q
|
|
SOLHEAD W @IOF W !?2,"ORDERABLE ITEM (SOLUTION) DOSE FORM",?69,"PAGE ",PAGE,!," SOLUTION VOLUME",!,LINE S PAGE=PAGE+1
|
|
I ZFLAG W !!,FFF," ",ZZZ Q
|
|
I GFLAG W !!,FFF," ",ZZZ," (cont.)"
|
|
S GFLAG=0 Q
|
|
CANT ;
|
|
D ^PSSSPD I VAONLY K ^TMP("PSSD",$J),^TMP("PSS",$J)
|
|
SKIP D:VAONLY CANT^PSSPOIM D:'VAONLY CANT^PSSPOIC
|
|
K LINE S $P(LINE,"-",79)="",PAGE=1,(ZFLAG,GFLAG)=0
|
|
D ADDCANT
|
|
D SOLCANT
|
|
NO S PAGE=1 D NOHEAD
|
|
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
|
|
.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)
|
|
W @IOF G END
|
|
NOHEAD 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
|
|
I ZFLAG W !,EEE,?43,REASON S ZFLAG=0
|
|
Q
|
|
ADDCANT ;
|
|
D HEADA
|
|
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
|
|
.S ANM=$O(^PS(52.6,"AC",ANM,0)),ANM=$P($G(^PS(52.6,+$G(ANM),0)),"^")
|
|
W @IOF Q
|
|
HEADA W @IOF W !?2,"ORDERABLE ITEMS - ADDITIVES THAT CANNOT AUTO MATCH",?69,"PAGE ",PAGE,!,LINE S PAGE=PAGE+1
|
|
Q
|
|
SOLCANT ;
|
|
S PAGE=1 D HEADS
|
|
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
|
|
.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)),"^")
|
|
W @IOF Q
|
|
HEADS W @IOF W !?2,"ORDERABLE ITEMS - SOLUTIONS THAT CANNOT AUTO MATCH",?69,"PAGE ",PAGE,!,LINE S PAGE=PAGE+1
|
|
Q
|
|
CPK 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
|
|
Q
|
|
CPK1 K PSSITEQT Q
|