PSSPOIKA ;BIR/RTR-Orderable Item reports ;09/01/98
;;1.0;PHARMACY DATA MANAGEMENT;**15,38**;9/30/97
S PSSITE=+$O(^PS(59.7,0)) I +$P($G(^PS(59.7,PSSITE,80)),"^",2)<2 W !!?3,"Orderable Item Auto-Create has not been completed yet!",! K PSSITE,DIR S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR Q
;
K DIR,PSSITE S DIR(0)="S^M:Drugs that are matched;N:Drugs that are not matched",DIR("A",1)="Enter M to see all the IV Solutions, IV Additives, and Dispense Drugs that"
S DIR("A",2)="are matched to an Orderable Item. Enter N to see all IV Additives, IV",DIR("A",3)="Solutions, and Dispense Drugs that are not matched to an Orderable Item.",DIR("A",4)="",DIR("A")="Enter M or N"
D ^DIR K DIR G:Y["^"!($D(DTOUT))!($D(DUOUT)) END
S PSREP=$S(Y="M":1,1:0)
W $C(7),!!!,"** WARNING ** THIS REPORT MAY BE VERY LONG ** WARNING **"
D KMES^PSSPOIM1
W !!,"This report must be QUEUED to a printer!"
QUE W ! K %ZIS,IOP,ZTSK S %ZIS("B")="",%ZIS="QM" D ^%ZIS I POP G END
I $E(IOST)["C" W $C(7),!?5,"This report must be QUEUED to a printer, enter Q at Device prompt!",! G QUE
;!('$D(IO("Q")))
S ZTRTN=$S(PSREP:"MATCH^PSSPOIKA",1:"NOT^PSSPOIKA"),ZTDESC=$S(PSREP:"Matched Orderable Item Report",1:"Not matched Drug report") D ^%ZTLOAD K IO("Q")
END K AA,BB,CC,DOSE,DTOUT,DUOUT,EE,GFLAG,LIN,MM,NDNODE,NME,NN,PSPOI,PSREP,REA,Y,ZFG,ZFLAG,RR,SS,ZZ,PAGE,KK,LL,TT,WW,VV,PSDIS D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
MATCH ; drugs that are matche
DIS S PAGE=1,$P(LIN,"-",79)="",(ZFG,GFLAG)=0 D DHEAD
S MM="" F S MM=$O(^PS(50.7,"ADF",MM)) Q:MM="" F NN=0:0 S NN=$O(^PS(50.7,"ADF",MM,NN)) Q:'NN F TT=0:0 S TT=$O(^PS(50.7,"ADF",MM,NN,TT)) Q:'TT I $P($G(^PS(50.7,TT,0)),"^",3)'=1,$D(^PSDRUG("ASP",TT)) D D ADD,SOL
.S NME=$P($G(^PS(50.7,TT,0)),"^"),DOSE=$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^")
.S:($Y+6)>IOSL ZFG=1 D:ZFG DHEAD
.W:'ZFG !,LIN,!,"("_TT_") "_NME," ",DOSE S ZFG=0
.F LL=0:0 S LL=$O(^PSDRUG("ASP",TT,LL)) Q:'LL D
..S:($Y+4)>IOSL GFLAG=1 D:GFLAG DHEAD W !?2,"("_LL_")",?9,"Dispense Drug -> ",$P($G(^PSDRUG(LL,0)),"^")
W @IOF G END
ADD S RR="" F S RR=$O(^PS(52.6,"AOI",TT,RR)) Q:'RR S PSPOI=$P($G(^PS(52.6,RR,0)),"^",11) I PSPOI,$D(^PS(50.7,PSPOI,0)) D
.S:($Y+6)>IOSL GFLAG=1 D:GFLAG DHEAD W !,?2,"("_RR_")",?9,"Additive -> ",$P(^PS(52.6,RR,0),"^")
Q
SOL S EE="" F S EE=$O(^PS(52.7,"AOI",TT,EE)) Q:'EE S PSPOI=$P($G(^PS(52.7,EE,0)),"^",11) I PSPOI,$D(^PS(50.7,PSPOI,0)) D
.S:($Y+6)>IOSL GFLAG=1 D:GFLAG DHEAD W !,?2,"("_EE_")",?9,"Solution -> ",$P(^PS(52.7,EE,0),"^")," ",$P($G(^(0)),"^",3)
Q
DHEAD W @IOF W !?5,"ORDERABLE ITEM - DISPENSE DRUG (MATCHED REPORT)",?68,"PAGE: ",PAGE,!,LIN S PAGE=PAGE+1
I ZFG W !!,"("_TT_") "_NME," ",DOSE Q
I GFLAG W !!,"("_TT_") "_NME," ",DOSE," cont."
S GFLAG=0 Q
NOT ;not matched
NDIS K ^TMP("PSS",$J)
S PAGE=1,$P(LIN,"-",79)="" D NDHEAD
S CC="" F S CC=$O(^PSDRUG("B",CC)) Q:CC="" F EE=0:0 S EE=$O(^PSDRUG("B",CC,EE)) Q:'EE I '$P($G(^PSDRUG(EE,2)),"^") D D NADD,NSOL W !,LIN
.S REA="" S NDNODE=$G(^PSDRUG(EE,"ND")) I $P(NDNODE,"^"),$P(NDNODE,"^",3) S DA=$P($G(NDNODE),"^"),X=$$VAGN^PSNAPIS(DA) I $G(X)'=0,$L(X)>40 S REA="(VA Generic name > 40 characters)"
.I REA="" S REA=$S('$P($G(NDNODE),"^"):"(Not matched to NDF)",'$P($G(NDNODE),"^",3):"(No VA Product name entry)",$G(X)=0:"(Invalid NDF match for this drug)",1:"")
.D:($Y+5)>IOSL NDHEAD W !,"("_EE_") "_$P($G(^PSDRUG(EE,0)),"^")," ",$G(REA)
W @IOF G FINAL
NADD ;
S AA="" F S AA=$O(^PS(52.6,"B",AA)) Q:AA="" F SS=0:0 S SS=$O(^PS(52.6,"B",AA,SS)) Q:'SS S PSPOI=$G(^PS(52.6,SS,0)) I '$P(PSPOI,"^",11) S:$P(PSPOI,"^",2)="" ^TMP("PSS",$J,AA,SS)="A" I $P(PSPOI,"^",2)=EE D
.S PSDIS=0,PSDIS=$P($G(^PS(52.6,SS,0)),"^",2)
.D:($Y+6)>IOSL NDHEAD W !,?2,"("_SS_") "_$P($G(^PS(52.6,SS,0)),"^")," -> ",$S(PSDIS:$P($G(^PSDRUG(PSDIS,0)),"^"),1:"(not matched to a Dispense Drug)")," (A)"
Q
NSOL ;
S BB="" F S BB=$O(^PS(52.7,"B",BB)) Q:BB="" F ZZ=0:0 S ZZ=$O(^PS(52.7,"B",BB,ZZ)) Q:'ZZ S PSPOI=$G(^PS(52.7,ZZ,0)) I '$P(PSPOI,"^",11) S:$P(PSPOI,"^",2)="" ^TMP("PSS",$J,BB,ZZ)="S" I $P(PSPOI,"^",2)=EE D
.D:($Y+6)>IOSL NDHEAD W !,?2,"("_ZZ_") "_$P($G(^PS(52.7,ZZ,0)),"^")," ",$P($G(^(0)),"^",3)_" (S)"
Q
FINAL S PAGE=1 D NASH
S AA="" F S AA=$O(^TMP("PSS",$J,AA)) Q:AA="" F RR=0:0 S RR=$O(^TMP("PSS",$J,AA,RR)) Q:'RR D:($Y+6)>IOSL NASH W !,"("_RR_")",?9,AA," ("_$G(^TMP("PSS",$J,AA,RR))_")"," (Not matched to a dispense drug)"
W @IOF G END
NASH W @IOF W !?5,"ADDITIVES/SOLUTIONS NOT MATCHED TO AN ORDERABLE ITEM",?68,"PAGE: ",PAGE,!,LIN S PAGE=PAGE+1
Q
NDHEAD W @IOF W !?5,"DISPENSE DRUGS (NOT MATCHED TO ORDERABLE ITEM)",?68,"PAGE: ",PAGE,!,LIN S PAGE=PAGE+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSPOIKA 4663 printed Apr 09, 2024@21:35:29 Page 2
PSSPOIKA ;BIR/RTR-Orderable Item reports ;09/01/98
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**15,38**;9/30/97
+2 SET PSSITE=+$ORDER(^PS(59.7,0))
IF +$PIECE($GET(^PS(59.7,PSSITE,80)),"^",2)<2
WRITE !!?3,"Orderable Item Auto-Create has not been completed yet!",!
KILL PSSITE,DIR
SET DIR(0)="E"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
KILL DIR
QUIT
+3 ;
+4 KILL DIR,PSSITE
SET DIR(0)="S^M:Drugs that are matched;N:Drugs that are not matched"
SET DIR("A",1)="Enter M to see all the IV Solutions, IV Additives, and Dispense Drugs that"
+5 SET DIR("A",2)="are matched to an Orderable Item. Enter N to see all IV Additives, IV"
SET DIR("A",3)="Solutions, and Dispense Drugs that are not matched to an Orderable Item."
SET DIR("A",4)=""
SET DIR("A")="Enter M or N"
+6 DO ^DIR
KILL DIR
if Y["^"!($DATA(DTOUT))!($DATA(DUOUT))
GOTO END
+7 SET PSREP=$SELECT(Y="M":1,1:0)
+8 WRITE $CHAR(7),!!!,"** WARNING ** THIS REPORT MAY BE VERY LONG ** WARNING **"
+9 DO KMES^PSSPOIM1
+10 WRITE !!,"This report must be QUEUED to a printer!"
QUE WRITE !
KILL %ZIS,IOP,ZTSK
SET %ZIS("B")=""
SET %ZIS="QM"
DO ^%ZIS
IF POP
GOTO END
+1 IF $EXTRACT(IOST)["C"
WRITE $CHAR(7),!?5,"This report must be QUEUED to a printer, enter Q at Device prompt!",!
GOTO QUE
+2 ;!('$D(IO("Q")))
+3 SET ZTRTN=$SELECT(PSREP:"MATCH^PSSPOIKA",1:"NOT^PSSPOIKA")
SET ZTDESC=$SELECT(PSREP:"Matched Orderable Item Report",1:"Not matched Drug report")
DO ^%ZTLOAD
KILL IO("Q")
END KILL AA,BB,CC,DOSE,DTOUT,DUOUT,EE,GFLAG,LIN,MM,NDNODE,NME,NN,PSPOI,PSREP,REA,Y,ZFG,ZFLAG,RR,SS,ZZ,PAGE,KK,LL,TT,WW,VV,PSDIS
DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
MATCH ; drugs that are matche
DIS SET PAGE=1
SET $PIECE(LIN,"-",79)=""
SET (ZFG,GFLAG)=0
DO DHEAD
+1 SET MM=""
FOR
SET MM=$ORDER(^PS(50.7,"ADF",MM))
if MM=""
QUIT
FOR NN=0:0
SET NN=$ORDER(^PS(50.7,"ADF",MM,NN))
if 'NN
QUIT
FOR TT=0:0
SET TT=$ORDER(^PS(50.7,"ADF",MM,NN,TT))
if 'TT
QUIT
IF $PIECE($GET(^PS(50.7,TT,0)),"^",3)'=1
IF $DATA(^PSDRUG("ASP",TT))
Begin DoDot:1
+2 SET NME=$PIECE($GET(^PS(50.7,TT,0)),"^")
SET DOSE=$PIECE($GET(^PS(50.606,+$PIECE($GET(^(0)),"^",2),0)),"^")
+3 if ($Y+6)>IOSL
SET ZFG=1
if ZFG
DO DHEAD
+4 if 'ZFG
WRITE !,LIN,!,"("_TT_") "_NME," ",DOSE
SET ZFG=0
+5 FOR LL=0:0
SET LL=$ORDER(^PSDRUG("ASP",TT,LL))
if 'LL
QUIT
Begin DoDot:2
+6 if ($Y+4)>IOSL
SET GFLAG=1
if GFLAG
DO DHEAD
WRITE !?2,"("_LL_")",?9,"Dispense Drug -> ",$PIECE($GET(^PSDRUG(LL,0)),"^")
End DoDot:2
End DoDot:1
DO ADD
DO SOL
+7 WRITE @IOF
GOTO END
ADD SET RR=""
FOR
SET RR=$ORDER(^PS(52.6,"AOI",TT,RR))
if 'RR
QUIT
SET PSPOI=$PIECE($GET(^PS(52.6,RR,0)),"^",11)
IF PSPOI
IF $DATA(^PS(50.7,PSPOI,0))
Begin DoDot:1
+1 if ($Y+6)>IOSL
SET GFLAG=1
if GFLAG
DO DHEAD
WRITE !,?2,"("_RR_")",?9,"Additive -> ",$PIECE(^PS(52.6,RR,0),"^")
End DoDot:1
+2 QUIT
SOL SET EE=""
FOR
SET EE=$ORDER(^PS(52.7,"AOI",TT,EE))
if 'EE
QUIT
SET PSPOI=$PIECE($GET(^PS(52.7,EE,0)),"^",11)
IF PSPOI
IF $DATA(^PS(50.7,PSPOI,0))
Begin DoDot:1
+1 if ($Y+6)>IOSL
SET GFLAG=1
if GFLAG
DO DHEAD
WRITE !,?2,"("_EE_")",?9,"Solution -> ",$PIECE(^PS(52.7,EE,0),"^")," ",$PIECE($GET(^(0)),"^",3)
End DoDot:1
+2 QUIT
DHEAD WRITE @IOF
WRITE !?5,"ORDERABLE ITEM - DISPENSE DRUG (MATCHED REPORT)",?68,"PAGE: ",PAGE,!,LIN
SET PAGE=PAGE+1
+1 IF ZFG
WRITE !!,"("_TT_") "_NME," ",DOSE
QUIT
+2 IF GFLAG
WRITE !!,"("_TT_") "_NME," ",DOSE," cont."
+3 SET GFLAG=0
QUIT
NOT ;not matched
NDIS KILL ^TMP("PSS",$JOB)
+1 SET PAGE=1
SET $PIECE(LIN,"-",79)=""
DO NDHEAD
+2 SET CC=""
FOR
SET CC=$ORDER(^PSDRUG("B",CC))
if CC=""
QUIT
FOR EE=0:0
SET EE=$ORDER(^PSDRUG("B",CC,EE))
if 'EE
QUIT
IF '$PIECE($GET(^PSDRUG(EE,2)),"^")
Begin DoDot:1
+3 SET REA=""
SET NDNODE=$GET(^PSDRUG(EE,"ND"))
IF $PIECE(NDNODE,"^")
IF $PIECE(NDNODE,"^",3)
SET DA=$PIECE($GET(NDNODE),"^")
SET X=$$VAGN^PSNAPIS(DA)
IF $GET(X)'=0
IF $LENGTH(X)>40
SET REA="(VA Generic name > 40 characters)"
+4 IF REA=""
SET REA=$SELECT('$PIECE($GET(NDNODE),"^"):"(Not matched to NDF)",'$PIECE($GET(NDNODE),"^",3):"(No VA Product name entry)",$GET(X)=0:"(Invalid NDF match for this drug)",1:"")
+5 if ($Y+5)>IOSL
DO NDHEAD
WRITE !,"("_EE_") "_$PIECE($GET(^PSDRUG(EE,0)),"^")," ",$GET(REA)
End DoDot:1
DO NADD
DO NSOL
WRITE !,LIN
+6 WRITE @IOF
GOTO FINAL
NADD ;
+1 SET AA=""
FOR
SET AA=$ORDER(^PS(52.6,"B",AA))
if AA=""
QUIT
FOR SS=0:0
SET SS=$ORDER(^PS(52.6,"B",AA,SS))
if 'SS
QUIT
SET PSPOI=$GET(^PS(52.6,SS,0))
IF '$PIECE(PSPOI,"^",11)
if $PIECE(PSPOI,"^",2)=""
SET ^TMP("PSS",$JOB,AA,SS)="A"
IF $PIECE(PSPOI,"^",2)=EE
Begin DoDot:1
+2 SET PSDIS=0
SET PSDIS=$PIECE($GET(^PS(52.6,SS,0)),"^",2)
+3 if ($Y+6)>IOSL
DO NDHEAD
WRITE !,?2,"("_SS_") "_$PIECE($GET(^PS(52.6,SS,0)),"^")," -> ",$SELECT(PSDIS:$PIECE($GET(^PSDRUG(PSDIS,0)),"^"),1:"(not matched to a Dispense Drug)")," (A)"
End DoDot:1
+4 QUIT
NSOL ;
+1 SET BB=""
FOR
SET BB=$ORDER(^PS(52.7,"B",BB))
if BB=""
QUIT
FOR ZZ=0:0
SET ZZ=$ORDER(^PS(52.7,"B",BB,ZZ))
if 'ZZ
QUIT
SET PSPOI=$GET(^PS(52.7,ZZ,0))
IF '$PIECE(PSPOI,"^",11)
if $PIECE(PSPOI,"^",2)=""
SET ^TMP("PSS",$JOB,BB,ZZ)="S"
IF $PIECE(PSPOI,"^",2)=EE
Begin DoDot:1
+2 if ($Y+6)>IOSL
DO NDHEAD
WRITE !,?2,"("_ZZ_") "_$PIECE($GET(^PS(52.7,ZZ,0)),"^")," ",$PIECE($GET(^(0)),"^",3)_" (S)"
End DoDot:1
+3 QUIT
FINAL SET PAGE=1
DO NASH
+1 SET AA=""
FOR
SET AA=$ORDER(^TMP("PSS",$JOB,AA))
if AA=""
QUIT
FOR RR=0:0
SET RR=$ORDER(^TMP("PSS",$JOB,AA,RR))
if 'RR
QUIT
if ($Y+6)>IOSL
DO NASH
WRITE !,"("_RR_")",?9,AA," ("_$GET(^TMP("PSS",$JOB,AA,RR))_")"," (Not matched to a dispense drug)"
+2 WRITE @IOF
GOTO END
NASH WRITE @IOF
WRITE !?5,"ADDITIVES/SOLUTIONS NOT MATCHED TO AN ORDERABLE ITEM",?68,"PAGE: ",PAGE,!,LIN
SET PAGE=PAGE+1
+1 QUIT
NDHEAD WRITE @IOF
WRITE !?5,"DISPENSE DRUGS (NOT MATCHED TO ORDERABLE ITEM)",?68,"PAGE: ",PAGE,!,LIN
SET PAGE=PAGE+1
+1 QUIT
