source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSPOIKA.m@ 1639

Last change on this file since 1639 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1PSSPOIKA ;BIR/RTR-Orderable Item reports ;09/01/98
2 ;;1.0;PHARMACY DATA MANAGEMENT;**15,38**;9/30/97
3 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
4 ;
5 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"
6 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"
7 D ^DIR K DIR G:Y["^"!($D(DTOUT))!($D(DUOUT)) END
8 S PSREP=$S(Y="M":1,1:0)
9 W $C(7),!!!,"** WARNING ** THIS REPORT MAY BE VERY LONG ** WARNING **"
10 D KMES^PSSPOIM1
11 W !!,"This report must be QUEUED to a printer!"
12QUE W ! K %ZIS,IOP,ZTSK S %ZIS("B")="",%ZIS="QM" D ^%ZIS I POP G END
13 I $E(IOST)["C" W $C(7),!?5,"This report must be QUEUED to a printer, enter Q at Device prompt!",! G QUE
14 ;!('$D(IO("Q")))
15 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")
16END 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
17MATCH ; drugs that are matche
18DIS S PAGE=1,$P(LIN,"-",79)="",(ZFG,GFLAG)=0 D DHEAD
19 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
20 .S NME=$P($G(^PS(50.7,TT,0)),"^"),DOSE=$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^")
21 .S:($Y+6)>IOSL ZFG=1 D:ZFG DHEAD
22 .W:'ZFG !,LIN,!,"("_TT_") "_NME," ",DOSE S ZFG=0
23 .F LL=0:0 S LL=$O(^PSDRUG("ASP",TT,LL)) Q:'LL D
24 ..S:($Y+4)>IOSL GFLAG=1 D:GFLAG DHEAD W !?2,"("_LL_")",?9,"Dispense Drug -> ",$P($G(^PSDRUG(LL,0)),"^")
25 W @IOF G END
26ADD 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
27 .S:($Y+6)>IOSL GFLAG=1 D:GFLAG DHEAD W !,?2,"("_RR_")",?9,"Additive -> ",$P(^PS(52.6,RR,0),"^")
28 Q
29SOL 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
30 .S:($Y+6)>IOSL GFLAG=1 D:GFLAG DHEAD W !,?2,"("_EE_")",?9,"Solution -> ",$P(^PS(52.7,EE,0),"^")," ",$P($G(^(0)),"^",3)
31 Q
32DHEAD W @IOF W !?5,"ORDERABLE ITEM - DISPENSE DRUG (MATCHED REPORT)",?68,"PAGE: ",PAGE,!,LIN S PAGE=PAGE+1
33 I ZFG W !!,"("_TT_") "_NME," ",DOSE Q
34 I GFLAG W !!,"("_TT_") "_NME," ",DOSE," cont."
35 S GFLAG=0 Q
36NOT ;not matched
37NDIS K ^TMP("PSS",$J)
38 S PAGE=1,$P(LIN,"-",79)="" D NDHEAD
39 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
40 .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)"
41 .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:"")
42 .D:($Y+5)>IOSL NDHEAD W !,"("_EE_") "_$P($G(^PSDRUG(EE,0)),"^")," ",$G(REA)
43 W @IOF G FINAL
44NADD ;
45 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
46 .S PSDIS=0,PSDIS=$P($G(^PS(52.6,SS,0)),"^",2)
47 .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)"
48 Q
49NSOL ;
50 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
51 .D:($Y+6)>IOSL NDHEAD W !,?2,"("_ZZ_") "_$P($G(^PS(52.7,ZZ,0)),"^")," ",$P($G(^(0)),"^",3)_" (S)"
52 Q
53FINAL S PAGE=1 D NASH
54 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)"
55 W @IOF G END
56NASH W @IOF W !?5,"ADDITIVES/SOLUTIONS NOT MATCHED TO AN ORDERABLE ITEM",?68,"PAGE: ",PAGE,!,LIN S PAGE=PAGE+1
57 Q
58NDHEAD W @IOF W !?5,"DISPENSE DRUGS (NOT MATCHED TO ORDERABLE ITEM)",?68,"PAGE: ",PAGE,!,LIN S PAGE=PAGE+1
59 Q
Note: See TracBrowser for help on using the repository browser.