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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSMATCH 5378 printed Nov 22, 2024@17:43:01 Page 2
PSSMATCH ;BIR/RTR-Reports for Orderable Items ; 09/02/97 8:40
+1 ;;1.0;PHARMACY DATA MANAGEMENT;;9/30/97
PRI DO CPK
if $GET(PSSITEQT)
GOTO CPK1
WRITE !,"These reports are based on creating your Orderable Item file by Primary Name,",!,"then by VA Generic Name."
SET VAONLY=0
GOTO DIR
VA DO CPK
if $GET(PSSITEQT)
GOTO CPK1
WRITE !,"There reports are based on creating your Orderable Item File by VA Generic Name."
SET VAONLY=1
DIR KILL DIR
SET DIR(0)="S^M:Drugs that will match;C:Drugs that can't be matched"
SET DIR("A",1)="Enter M for Orderable Items that will auto-create,"
SET DIR("A",2)="which includes Dispense Drugs, Additives, and Solutions that will match."
+1 SET DIR("A",3)="Enter C for the report of Dispense Drugs that can't auto-match."
SET DIR("A",4)=""
SET DIR("A")="Enter M or C"
DO ^DIR
KILL DIR
+2 if Y["^"!($DATA(DUOUT))!($DATA(DTOUT))
GOTO END
+3 SET PSMATCH=$SELECT(Y="M":1,1:0)
+4 WRITE $CHAR(7),!!,"**WARNING** THIS REPORT MAY BE VERY LONG!"
+5 DO RMES^PSSPOIM1
QUE WRITE !
KILL %ZIS,IOP,ZTSK
SET %ZIS("B")=""
SET %ZIS="QM"
DO ^%ZIS
IF POP
GOTO END
+1 IF $EXTRACT(IOST)["C"!('$DATA(IO("Q")))
WRITE $CHAR(7),!?5,"This report must be QUEUED to a printer, enter Q at Device prompt!",!
GOTO QUE
+2 SET ZTRTN="BEG^PSSMATCH"
SET ZTDESC="Orderable Item Reports"
SET ZTSAVE("PSMATCH")=""
SET ZTSAVE("VAONLY")=""
DO ^%ZTLOAD
KILL IO("Q")
END KILL ^TMP("PSSD",$JOB),^TMP("PSS",$JOB),^TMP("PSSADD",$JOB),^TMP("PSSOL",$JOB),AAA,BBB,DIR,DOSEFORM,EEE,GFLAG,GGG,LINE,LLL,PAGE,PSMATCH,PSODD,PSOIV,PSOLU,REASON,ANM,AVL,SSS,TTT,VAONLY,VARONE,VARTWO,ZFLAG,ZZZ
DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
BEG SET SSITE=$ORDER(^PS(59.7,0))
SET SITEADD=$SELECT($PIECE($GET(^PS(59.7,+SSITE,31)),"^",2)'="":$PIECE(^(31),"^",2),1:"IV")
KILL SSITE
+1 if 'PSMATCH
GOTO CANT
+2 DO ^PSSSPD
IF VAONLY
KILL ^TMP("PSSD",$JOB),^TMP("PSS",$JOB),^TMP("PSSADD",$JOB,"ZZZZ"),^TMP("PSSOL",$JOB,"ZZZZ")
GOTO PASS
+3 KILL ^TMP("PSSD",$JOB,"ZZZZ"),^TMP("PSSADD",$JOB,"ZZZZ"),^TMP("PSSOL",$JOB,"ZZZZ")
PASS if VAONLY
DO BEG^PSSPOIM
if 'VAONLY
DO BEG^PSSPOIC
+1 KILL LINE
SET $PIECE(LINE,"-",79)=""
SET PAGE=1
SET (ZFLAG,GFLAG)=0
+2 DO ADD
+3 DO SOL
+4 SET PAGE=1
DO HEAD
+5 SET ZZZ=""
FOR
SET ZZZ=$ORDER(^TMP("PSSD",$JOB,ZZZ))
if ZZZ=""
QUIT
if ($Y+6)>IOSL
SET ZFLAG=1
if ZFLAG
DO HEAD
if 'ZFLAG
WRITE !,LINE,!,ZZZ
SET ZFLAG=0
SET GGG=""
FOR
SET GGG=$ORDER(^TMP("PSSD",$JOB,ZZZ,GGG))
if GGG=""
QUIT
Begin DoDot:1
+6 if ($Y+4)>IOSL
SET GFLAG=1
if GFLAG
DO HEAD
WRITE !,?2,GGG," ",$SELECT(^TMP("PSSD",$JOB,ZZZ,GGG)'="":"("_$EXTRACT($PIECE(^(GGG),"^"),1,33)_")",1:"")
End DoDot:1
+7 WRITE @IOF
GOTO END
HEAD WRITE @IOF
+1 IF $GET(VAONLY)
WRITE !,?2,"ORDERABLE ITEMS - MATCHES BY VA GENERIC NAME ONLY PAGE ",PAGE
+2 IF '$GET(VAONLY)
WRITE !,?2,"ORDERABLE ITEMS - MATCHES BY PRIMARY NAME THEN VA GENERIC NAME PAGE ",PAGE,!?4,"(PRIMARY DRUG) IN PARENTHESIS"
+3 WRITE !,LINE
SET PAGE=PAGE+1
+4 IF ZFLAG
WRITE !!,ZZZ
QUIT
+5 IF GFLAG
WRITE !!,ZZZ," (cont.)"
+6 SET GFLAG=0
QUIT
ADD ;
+1 DO ADHEAD
+2 SET AAA=""
FOR
SET AAA=$ORDER(^TMP("PSSADD",$JOB,AAA))
if AAA=""
QUIT
SET VARTWO=""
SET PSODD=$ORDER(^TMP("PSSADD",$JOB,AAA,VARTWO))
SET DOSEFORM=^(PSODD)
Begin DoDot:1
+3 if ($Y+5)>IOSL
DO ADHEAD
WRITE !,AAA," ",SITEADD,!?3,PSODD," ",DOSEFORM,!,LINE
End DoDot:1
+4 WRITE @IOF
QUIT
ADHEAD WRITE @IOF
WRITE !?2,"ORDERABLE ITEM (ADDITIVE) IV FLAG",?69,"PAGE ",PAGE,!," DISPENSE DRUG DOSE FORM",!,LINE
SET PAGE=PAGE+1
+1 QUIT
SOL ;
+1 SET PAGE=1
SET (GFLAG,ZFLAG)=0
DO SOLHEAD
+2 SET FFF=""
FOR
SET FFF=$ORDER(^TMP("PSSOL",$JOB,FFF))
if FFF=""
QUIT
SET ZZZ=""
FOR
SET ZZZ=$ORDER(^TMP("PSSOL",$JOB,FFF,ZZZ))
if ZZZ=""
QUIT
Begin DoDot:1
+3 if ($Y+6)>IOSL
SET ZFLAG=1
if ZFLAG
DO SOLHEAD
if 'ZFLAG
WRITE !,LINE,!,FFF," ",ZZZ
SET ZFLAG=0
SET WWW=""
FOR
SET WWW=$ORDER(^TMP("PSSOL",$JOB,FFF,ZZZ,WWW))
if WWW=""
QUIT
Begin DoDot:2
+4 if ($Y+4)>IOSL
SET GFLAG=1
if GFLAG
DO SOLHEAD
WRITE !?2,FFF," ",$PIECE($GET(^PS(52.7,+^TMP("PSSOL",$JOB,FFF,ZZZ,WWW),0)),"^",3)
End DoDot:2
End DoDot:1
+5 WRITE @IOF
QUIT
SOLHEAD WRITE @IOF
WRITE !?2,"ORDERABLE ITEM (SOLUTION) DOSE FORM",?69,"PAGE ",PAGE,!," SOLUTION VOLUME",!,LINE
SET PAGE=PAGE+1
+1 IF ZFLAG
WRITE !!,FFF," ",ZZZ
QUIT
+2 IF GFLAG
WRITE !!,FFF," ",ZZZ," (cont.)"
+3 SET GFLAG=0
QUIT
CANT ;
+1 DO ^PSSSPD
IF VAONLY
KILL ^TMP("PSSD",$JOB),^TMP("PSS",$JOB)
SKIP if VAONLY
DO CANT^PSSPOIM
if 'VAONLY
DO CANT^PSSPOIC
+1 KILL LINE
SET $PIECE(LINE,"-",79)=""
SET PAGE=1
SET (ZFLAG,GFLAG)=0
+2 DO ADDCANT
+3 DO SOLCANT
NO SET PAGE=1
DO NOHEAD
+1 SET EEE=""
FOR
SET EEE=$ORDER(^TMP("PSSD",$JOB,"ZZZZ",EEE))
if EEE=""
QUIT
SET REASON=^(EEE)
if ($Y+5)>IOSL
DO NOHEAD
WRITE !,EEE,?43,REASON
if ($ORDER(^(EEE,0)))
Begin DoDot:1
+2 FOR TTT=0:0
SET TTT=$ORDER(^TMP("PSSD",$JOB,"ZZZZ",EEE,TTT))
if 'TTT
QUIT
if ($Y+5)>IOSL
SET ZFLAG=1
if ($Y+5)>IOSL
DO NOHEAD
WRITE !?3,^(TTT)
End DoDot:1
WRITE !,LINE
+3 WRITE @IOF
GOTO END
NOHEAD WRITE @IOF
WRITE !,?2,$SELECT($GET(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
SET PAGE=PAGE+1
+1 IF ZFLAG
WRITE !,EEE,?43,REASON
SET ZFLAG=0
+2 QUIT
ADDCANT ;
+1 DO HEADA
+2 SET BBB=""
FOR
SET BBB=$ORDER(^TMP("PSSADD",$JOB,"ZZZZ",BBB))
if BBB=""
QUIT
SET REASON=^(BBB)
SET ANM=$ORDER(^PSDRUG("B",BBB,0))
if 'ANM
QUIT
Begin DoDot:1
+3 SET ANM=$ORDER(^PS(52.6,"AC",ANM,0))
SET ANM=$PIECE($GET(^PS(52.6,+$GET(ANM),0)),"^")
End DoDot:1
if ANM=""
QUIT
if ($Y+5)>IOSL
DO HEADA
WRITE !,ANM,?43,$GET(REASON),!,LINE
+4 WRITE @IOF
QUIT
HEADA WRITE @IOF
WRITE !?2,"ORDERABLE ITEMS - ADDITIVES THAT CANNOT AUTO MATCH",?69,"PAGE ",PAGE,!,LINE
SET PAGE=PAGE+1
+1 QUIT
SOLCANT ;
+1 SET PAGE=1
DO HEADS
+2 SET LLL=""
FOR
SET LLL=$ORDER(^TMP("PSSOL",$JOB,"ZZZZ",LLL))
if LLL=""
QUIT
SET REASON=^(LLL)
SET ANM=$ORDER(^PSDRUG("B",LLL,0))
if 'ANM
QUIT
Begin DoDot:1
+3 SET ANM=$ORDER(^PS(52.7,"AC",ANM,0))
SET AVL=$PIECE($GET(^PS(52.7,+$GET(ANM),0)),"^",3)
SET ANM=$PIECE($GET(^PS(52.7,+$GET(ANM),0)),"^")
End DoDot:1
if ANM=""
QUIT
if ($Y+6)>IOSL
DO HEADS
WRITE !,ANM,?43,AVL,!?5,$GET(REASON),!,LINE
+4 WRITE @IOF
QUIT
HEADS WRITE @IOF
WRITE !?2,"ORDERABLE ITEMS - SOLUTIONS THAT CANNOT AUTO MATCH",?69,"PAGE ",PAGE,!,LINE
SET PAGE=PAGE+1
+1 QUIT
CPK SET PSSITE=+$ORDER(^PS(59.7,0))
IF +$PIECE($GET(^PS(59.7,PSSITE,80)),"^",2)>1
WRITE !!,"The Orderable Item auto-create has already run to completion!",!
SET PSSITEQT=1
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
KILL DIR
+1 QUIT
CPK1 KILL PSSITEQT
QUIT
