source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSPOIDT.m@ 1474

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

initial load of WorldVistAEHR
File size: 8.6 KB
Line 
1PSSPOIDT ;BIR/RTR/WRT-Date update in Orderable Item File ;02/14/00
2 ;;1.0;PHARMACY DATA MANAGEMENT;**19,29,38,57,68,69,82**;9/30/97
3 ;Reference to ^PS(59 supported by DBIA #1976
4 ;Passed in is Internal number of Pharmacy Orderable Item
5 ;Changed all IIII's to II (PWC-4/5/04). Lines were too long to add new code.
6EN(PSPOINT) ;
7EN1 I $G(PSSCROSS) S:$G(PSSTEST) PSPOINT=PSSTEST I '$G(PSSTEST)!('$D(^PS(50.7,+$G(PSSTEST),0))) S:$D(ZTQUEUED) ZTREQ="@" Q
8 N DA,DR,DIE,X,Y,ZZZ,ZZZA,ZZZS,PSUAPP,INACFLAG,PSSVAP,PSSVNAME,PSSVDOSE,INCDATE,PSACDATE,WWWW,PSLATEST,PSSORDIT
9 Q:'$D(^PS(50.7,PSPOINT,0))
10 I $P(^PS(50.7,PSPOINT,0),"^",4) D SET G ENT
11 S PSSVNAME=$P($G(^PS(50.7,PSPOINT,0)),"^"),PSSVDOSE=$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^")
12 S PSACDATE=DT,PSLATEST=0
13 S INACFLAG=0
14 F ZZZ=0:0 S ZZZ=$O(^PS(50.7,"A50",PSPOINT,ZZZ)) Q:'ZZZ D
15 .S PSUAPP=$P($G(^PSDRUG(ZZZ,2)),"^",3) I PSUAPP["O"!(PSUAPP["X")!(PSUAPP["I")!(PSUAPP["U") S PSSVAP=$P($G(^PSDRUG(ZZZ,"I")),"^") S:PSSVAP&(PSSVAP>PSLATEST) PSLATEST=PSSVAP I 'PSSVAP S INACFLAG=1
16 .F ZZZA=0:0 S ZZZA=$O(^PSDRUG("A526",ZZZ,ZZZA)) Q:'ZZZA I $D(^PS(52.6,ZZZA,0)) S PSSVAP=+$P($G(^PS(52.6,ZZZA,"I")),"^") D
17 ..S:PSSVAP&(PSSVAP>PSLATEST) PSLATEST=PSSVAP I 'PSSVAP S INACFLAG=1
18 .F ZZZS=0:0 S ZZZS=$O(^PSDRUG("A527",ZZZ,ZZZS)) Q:'ZZZS I $D(^PS(52.7,ZZZS,0)) S PSSVAP=+$P($G(^PS(52.7,ZZZS,"I")),"^") D
19 ..S:PSSVAP&(PSSVAP>PSLATEST) PSLATEST=PSSVAP I 'PSSVAP S INACFLAG=1
20 I 'INACFLAG,'$P($G(^PS(50.7,PSPOINT,0)),"^",4) D
21 .W:'$G(PSSCROSS)&($G(PSLATEST)'>DT) !!,PSSVNAME," ",PSSVDOSE,!,"is being marked inactive since no Additives, Solutions, or Dispense Drugs",!,"marked with an 'I', 'O' or 'U' in the Application Package Use field are matched",!,"to it.",!
22 I 'INACFLAG,'$P($G(^PS(50.7,PSPOINT,0)),"^",4) S PSLATEST=$S('PSLATEST:DT,1:PSLATEST) S $P(^PS(50.7,PSPOINT,0),"^",4)=PSLATEST
23 D SET G ENT
24 Q
25SUP(PSSORDIT) ;Supply at Orderable Item
26ENT ;Enter here if coming from Inactive date, or from queued job
27 I '$D(^PS(50.7,PSSORDIT,0)) S:$D(ZTQUEUED) ZTREQ="@" Q
28 I $P(^PS(50.7,PSSORDIT,0),"^",3) D NONFORM G ENTZ
29 N ZZZ,ZZZZ,PSSSUP,PSSSUYES,PSSSAP,PSSINA,PSSQDATE,PSSQYES,HLDCROSS
30 D NONFORM,NONVA
31 S PSSSUP=$P(^PS(50.7,PSSORDIT,0),"^",9),(PSSSUYES,PSSQYES)=0 F ZZZ=0:0 S ZZZ=$O(^PS(50.7,"A50",PSSORDIT,ZZZ)) Q:'ZZZ!(PSSQYES) D
32 .I $P($G(^PSDRUG(ZZZ,0)),"^",3)["S" S PSSSAP=$P($G(^(2)),"^",3),PSSINA=$P($G(^("I")),"^") D
33 ..I PSSSAP["O"!(PSSSAP["I")!(PSSSAP["U")!(PSSSAP["X") I 'PSSINA S (PSSQYES,PSSSUYES)=1 Q
34 ..I PSSSAP["O"!(PSSSAP["I")!(PSSSAP["U")!(PSSSAP["X") I +PSSINA>DT S PSSQDATE($E(PSSINA,1,7))="",PSSSUYES=1
35 I 'PSSSUP,PSSSUYES S $P(^PS(50.7,PSSORDIT,0),"^",9)=1 W:'$G(PSSCROSS) !!,"The supply indicator is now being set for the Orderable Item",!,$P(^PS(50.7,PSSORDIT,0),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^"),!
36 I PSSSUP,'PSSSUYES S $P(^PS(50.7,PSSORDIT,0),"^",9)="" W:'$G(PSSCROSS) !!,"The supply indicator is now being removed for the Orderable Item",!,$P(^PS(50.7,PSSORDIT,0),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^"),!
37 I 'PSSQYES,PSSSUYES,$O(PSSQDATE(0)) F ZZZZ=0:0 S ZZZZ=$O(PSSQDATE(ZZZZ)) Q:'ZZZZ D
38 .S ZTRTN="ENT^PSSPOIDT",ZTIO="",ZTDTH=ZZZZ_.01,ZTDESC="Supply update for Orderable Item",ZTSAVE("PSSORDIT")="" S HLDCROSS=$G(PSSCROSS) S PSSCROSS=1,ZTSAVE("PSSCROSS")="" D ^%ZTLOAD K:'$G(HLDCROSS) PSSCROSS
39ENTZ I $G(PSSCROSS) D EN2^PSSHL1(PSSORDIT,"MUP")
40 S:$D(ZTQUEUED) ZTREQ="@"
41 Q
42SET S PSSORDIT=PSPOINT
43 Q
44REST(PSSREST) ;Ask to reactivate or inactivate others
45ASKQ K DIR W ! S DIR("A",1)="Do you want to "_$S(PSINORDE="I":"inactivate",1:"reactivate")_" all Drugs/Additives/Solutions",DIR("A")="that are matched to this Orderable Item?"
46 S DIR(0)="SB^Y:YES;N:NO;L:LIST ALL DRUGS/ADDITIVES/SOLUTIONS",DIR("B")="N" D ^DIR K DIR Q:$D(DIRUT)!($D(DUOUT))!($D(DTOUT))
47 ;I Y="L" H 1 D @$S($P(^PS(50.7,PSSREST,0),"^",3):"LADD",1:"LDIS") W:FLAG&($P(^PS(50.7,PSSREST,0),"^",3)) !!,"Nothing matched to this Orderable Item!",! G:FLAG QREST G ASKQ
48 I Y="L" K PSSCXXX,PSSCOUT D LDIS W:'$G(PSSCXXX)&('$G(PSSCOUT)) !!,"Nothing matched to this Orderable Item.",! G:'$G(PSSCXXX)&('$G(PSSCOUT)) QREST K PSSCXXX,PSSCOUT G ASKQ
49 I Y="Y" W !,"Please wait..",! D W !,"Finished!",!
50 .I $G(PSINORDE)="I" S PSIDATEX=$P($G(^PS(50.7,PSSREST,0)),"^",4) I PSIDATEX D
51 ..F II=0:0 S II=$O(^PS(52.7,"AOI",PSSREST,II)) Q:'II I $D(^PS(52.7,II,0)) S $P(^PS(52.7,II,"I"),"^")=PSIDATEX
52 ..F II=0:0 S II=$O(^PS(52.6,"AOI",PSSREST,II)) Q:'II I $D(^PS(52.6,II,0)) S $P(^PS(52.6,II,"I"),"^")=PSIDATEX
53 .I $G(PSINORDE)="D" D
54 ..F II=0:0 S II=$O(^PS(52.7,"AOI",PSSREST,II)) Q:'II I $D(^PS(52.7,II,0)),$P($G(^("I")),"^") S $P(^PS(52.7,II,"I"),"^")=""
55 ..F II=0:0 S II=$O(^PS(52.6,"AOI",PSSREST,II)) Q:'II I $D(^PS(52.6,II,0)),$P($G(^("I")),"^") S $P(^PS(52.6,II,"I"),"^")=""
56 .I $G(PSINORDE)="I" S PSIDATEX=$P($G(^PS(50.7,PSSREST,0)),"^",4) I PSIDATEX F II=0:0 S II=$O(^PSDRUG("ASP",PSSREST,II)) Q:'II I $D(^PSDRUG(II,0)) S $P(^PSDRUG(II,"I"),"^")=PSIDATEX D:'$G(PSSHUIDG) DRG^PSSHUIDG(II) D
57 ..N XX,DVER,DNSNAM,DNSPORT,DMFU S XX=""
58 ..F XX=0:0 S XX=$O(^PS(59,XX)) Q:'XX D
59 ..S DVER=$$GET1^DIQ(59,XX_",",105,"I"),DMFU=$$GET1^DIQ(59,XX_",",105.2)
60 ..I DVER="2.4" S DNSNAM=$$GET1^DIQ(59,XX_",",2006),DNSPORT=$$GET1^DIQ(59,XX_",",2007) I DNSNAM'=""&(DMFU="YES") D DRG^PSSDGUPD(II,"",DNSNAM,DNSPORT)
61 .I $G(PSINORDE)="D" F II=0:0 S II=$O(^PSDRUG("ASP",PSSREST,II)) Q:'II I $D(^PSDRUG(II,0)),$P($G(^PSDRUG(II,"I")),"^") S DA=II,DIE=50,DR="100///@" D ^DIE D:'$G(PSSHUIDG) DRG^PSSHUIDG(DA) D
62 ..N XX,DVER,DNSNAM,DNSPORT,DMFU S XX=""
63 ..F XX=0:0 S XX=$O(^PS(59,XX)) Q:'XX D
64 ..S DVER=$$GET1^DIQ(59,XX_",",105,"I"),DMFU=$$GET1^DIQ(59,XX_",",105.2)
65 ..I DVER="2.4" S DNSNAM=$$GET1^DIQ(59,XX_",",2006),DNSPORT=$$GET1^DIQ(59,XX_",",2007) I DNSNAM'=""&(DMFU="YES") D DRG^PSSDGUPD(II,"",DNSNAM,DNSPORT)
66 . K DA,DIE,DR
67 K II,PSIDATEX
68QREST K PSSCXXX,PSSCOUT Q
69LDIS ;list dispense drugs
70 N FLAG,PSSCFLAG,PSSCDATE,ZZ
71 S FLAG=1,(PSSCOUT,PSSCXXX)=0 D DHEAD F ZZ=0:0 S ZZ=$O(^PSDRUG("ASP",PSSREST,ZZ)) Q:'ZZ!($G(PSSCOUT)) S FLAG=0 D:($Y+5)>IOSL DHEAD Q:$G(PSSCOUT) I ZZ S PSSCXXX=1 W !,$P($G(^PSDRUG(ZZ,0)),"^") D DTE
72 Q:$G(PSSCOUT)
73 S (FLAG,PSSCFLAG)=0
74 F ZZ=0:0 S ZZ=$O(^PS(52.6,"AOI",PSSREST,ZZ)) Q:'ZZ!($G(PSSCOUT)) D:($Y+5)>IOSL DHEAD Q:$G(PSSCOUT) I ZZ D
75 .S (PSSCFLAG,PSSCXXX)=1
76 .W !,$P($G(^PS(52.6,ZZ,0)),"^"),?42,"(A)"
77 .S PSSCDATE=$P($G(^PS(52.6,ZZ,"I")),"^") I PSSCDATE D DTEX
78 Q:$G(PSSCOUT)
79 ;I $G(PSSCFLAG) W !
80 F ZZ=0:0 S ZZ=$O(^PS(52.7,"AOI",PSSREST,ZZ)) Q:'ZZ!($G(PSSCOUT)) D:($Y+5)>IOSL DHEAD Q:$G(PSSCOUT) I ZZ D
81 .W !,$P($G(^PS(52.7,ZZ,0)),"^"),?31,$P($G(^(0)),"^",3),?42,"(S)"
82 .S PSSCDATE=$P($G(^PS(52.7,ZZ,"I")),"^") I PSSCDATE D DTEX
83 Q
84DHEAD I 'FLAG W ! K DIR S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR I 'Y S PSSCOUT=1 Q
85 W @IOF W !,?6,"Orderable Item -> ",$P($G(^PS(50.7,PSSREST,0)),"^"),!?6,"Dosage Form -> ",$P($G(^PS(50.606,+$P($G(^PS(50.7,PSSREST,0)),"^",2),0)),"^"),!!,"Dispense Drugs:"_$S('FLAG:" (continued)",1:""),!,"---------------"
86 Q
87DTE I $D(^PSDRUG(ZZ,"I")) S Y=$P(^PSDRUG(ZZ,"I"),"^") D DD^%DT W ?50,Y K Y
88 Q
89DTEX S Y=$G(PSSCDATE) D DD^%DT W ?50,$G(Y) K Y
90 Q
91NONFORM ;
92 ;formulary status of Orderable Item
93 Q:'$G(PSSORDIT)
94 N PSNFX,PSNFX1,PSNFX2,PSNFXB
95 S (PSNFX1,PSNFX2)=0
96 S PSNFXB=$P($G(^PS(50.7,PSSORDIT,0)),"^",12)
97 F PSNFX=0:0 S PSNFX=$O(^PS(50.7,"A50",PSSORDIT,PSNFX)) Q:'PSNFX D
98 .I $P($G(^PSDRUG(PSNFX,2)),"^",3)'["O",$P($G(^(2)),"^",3)'["I",$P($G(^(2)),"^",3)'["U",$P($G(^(2)),"^",3)'["X" Q
99 .I $P($G(^PSDRUG(PSNFX,"I")),"^"),$P($G(^("I")),"^")'>DT Q
100 .I $P($G(^PSDRUG(PSNFX,0)),"^",9)=1 S PSNFX1=1 Q
101 .S PSNFX2=1
102 I PSNFX1,'PSNFX2 S $P(^PS(50.7,PSSORDIT,0),"^",12)=1
103 I PSNFX2 S $P(^PS(50.7,PSSORDIT,0),"^",12)=""
104 I $P($G(^PS(50.7,PSSORDIT,0)),"^",12)'=$G(PSNFXB),'$G(PSSCROSS) D
105 .W !!,"The Formulary Status of the Pharmacy Orderable Item",!,$P($G(^PS(50.7,PSSORDIT,0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^"),!,"has been changed to "_$S($P($G(^PS(50.7,PSSORDIT,0)),"^",12):"Non-Formulary.",1:"Formulary."),!
106 Q
107MSSG I '$G(PSSCROSS) W !!,"This Orderable Item is "_$S($P($G(^PS(50.7,PSSORDIT,0)),"^",12):"Non-Formulary.",1:"Formulary."),!
108 Q
109NONVA ; Evaluates the Non-VA Med Indicator of the Orderable Item
110 N PSNVADG,PSNONVA,PSDRG
111 ;
112 Q:'$G(PSSORDIT)
113 S PSNVADG=0,PSNONVA=$P($G(^PS(50.7,PSSORDIT,0)),"^",10),PSDRG=0
114 F S PSDRG=$O(^PS(50.7,"A50",PSSORDIT,PSDRG)) Q:'PSDRG!(PSNVADG) D
115 . I $P($G(^PSDRUG(PSDRG,"I")),"^"),$P($G(^("I")),"^")'>DT Q
116 . I $P($G(^PSDRUG(PSDRG,2)),"^",3)["X" S PSNVADG=1
117 ;
118 I PSNVADG S $P(^PS(50.7,PSSORDIT,0),"^",10)=1
119 I 'PSNVADG S $P(^PS(50.7,PSSORDIT,0),"^",10)=""
120 ;
121 I +$P($G(^PS(50.7,PSSORDIT,0)),"^",10)'=+PSNONVA,'$G(PSSCROSS) D
122 . W !!,"The Pharmacy Orderable Item ",$P($G(^PS(50.7,PSSORDIT,0)),"^")
123 . W !,"is ",$S('PSNONVA:"now",1:"no longer")," marked as a NON-VA MED Drug."
124 Q
Note: See TracBrowser for help on using the repository browser.