source: FOIAVistA/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSMATCH.m@ 677

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