- 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 Feb 19, 2025@00:00:01 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