source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOHCSUM.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 5.2 KB
Line 
1PSOHCSUM ;BHAM ISC/SAB - gather data for outpatient rx health care summary ;03/01/96 8:29
2 ;;7.0;OUTPATIENT PHARMACY;**4,35,48,54,46,103,132,214,200**;DEC 1997;Build 7
3 ;External reference to File ^PS(55 supported by DBIA 2228
4 ;External reference to File ^PSDRUG supported by DBIA 221
5 ;External reference to File ^PS(50.7 supported by DBIA 2223
6 ;External reference ^PS(50.606 supported by DBIA 2174
7 ;External reference to ^SC supported by DBIA 10040
8 ;Accepts DFN (assumed to be valid)
9 ;Looks for PSOBEGIN as earliest expiration/cancel date for search
10 ;If $D(PSOBEGIN)=0 use DT as earliest expiration/cancel date
11 ;returns data in ^TMP("PSOO",$J,Inverse last fill date,0)
12 ;data is ISSUE DATE^LAST FILL DATE^DRUG^PROVIDER^STATUS^RX#^QTY^#REFILLS^IFN^COST/FILL^EXP/CANC DATE
13 ;and ^TMP("PSOO",$J,Inverse last fill date,n,0)=SIG
14 ;NON-VA Meds: ^TMP("PSOO",$J,"NVA",n,0)=orderable item_" "_dose form^status (active or discontinued)^start date(fm format)^cprs order # (ptr to 100)^date/time documented (fm format)^documented by (ptr to 200_";"_.01)^dc date/time(fm format)
15 ;^TMP("PSOO",$J,"NVA",n,1,0)=dosage^med route^schedule^drug (file #50_";"_.01)^clinic (file #44_";"_.01)
16 ;^TMP("PSOO",$J,"NVA",n,"DSC",nn,0)=statement/explanation/comments
17 ;
18 ;returns PSOBEGIN (if sent or equal DT if not sent)
19 ;
20 ;If $D(PSOACT) loop thru PS(55,DFN,"P","A") from PSOBEGIN to get actives only
21 ;otherwise loop through entire "P" multiple to get all Rx's
22 ;
23 S ACS=0
24EN K ^TMP("PSOO",$J),PSONV
25 S PSOBEGIN=$S($D(PSOBEGIN):PSOBEGIN,1:DT)
26 I $D(PSOACT) F PSODT=PSOBEGIN-1:0 S PSODT=$O(^PS(55,DFN,"P","A",PSODT)) Q:'PSODT F PSORXX=0:0 S PSORXX=$O(^PS(55,DFN,"P","A",PSODT,PSORXX)) Q:'PSORXX D:$G(^PSRX(PSORXX,0))]"" GET
27 I '$D(PSOACT) F PSOI=0:0 S PSOI=$O(^PS(55,DFN,"P",PSOI)) Q:'PSOI S PSORXX=+^(PSOI,0) D:$G(^PSRX(PSORXX,0))]"" GET
28 F I=0:0 S I=$O(^PS(55,DFN,"NVA",I)) Q:'I S NVA=^PS(55,DFN,"NVA",I,0) D
29 .Q:'$P(NVA,"^") S PSONV=$G(PSONV)+1
30 .S ^TMP("PSOO",$J,"NVA",PSONV,0)=$S($D(^PS(50.7,$P(+NVA,"^"),0)):$P(^PS(50.7,$P(+NVA,"^"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^"),1:"")_"^"
31 .S ^TMP("PSOO",$J,"NVA",PSONV,0)=^TMP("PSOO",$J,"NVA",PSONV,0)_$S($P(NVA,"^",6):"Discontinued",1:"Active")_"^"_$P(NVA,"^",9)_"^"_$P(NVA,"^",8)_"^"_$P(NVA,"^",10)_"^"_$P(NVA,"^",11)_";"_$P($G(^VA(200,$P(NVA,"^",11),0)),"^")_"^"_$P(NVA,"^",7)
32 .S ^TMP("PSOO",$J,"NVA",PSONV,1,0)=$P(NVA,"^",3)_"^"_$P(NVA,"^",4)_"^"_$P(NVA,"^",5)_"^"_$S($P(NVA,"^",2):$P(NVA,"^",2)_";"_$P(^PSDRUG($P(NVA,"^",2),0),"^"),1:"")_"^"
33 .S ^TMP("PSOO",$J,"NVA",PSONV,1,0)=^TMP("PSOO",$J,"NVA",PSONV,1,0)_$S($D(^SC(+$P(NVA,"^",12),0)):$P(NVA,"^",12)_";"_$P(^SC($P(NVA,"^",12),0),"^"),1:"")
34 .F S=0:0 S S=$O(^PS(55,DFN,"NVA",I,"DSC",S)) Q:'S S ^TMP("PSOO",$J,"NVA",PSONV,"DSC",S,0)=^PS(55,DFN,"NVA",I,"DSC",S,0)
35 ;
36END K PSODT,PSOST,PSORXX,PSO0,PSO2,PSOIDD,PSOFD,PSODR,PSOPR,PSOREF,PSORFL,PSOI,PSOJ,PSOX,PSOCF,I,PSONV,NVA,PSOPN,PSORS
37 Q
38 ;
39GET Q:$P($G(^PSRX(PSORXX,"STA")),"^")=13 S PSO0=^PSRX(PSORXX,0),PSO2=$G(^(2)),PSOFD=+$G(^(3)),PSODR=$P(PSO0,"^",6),PSOPR=$P(PSO0,"^",4),PSOREF=$P(PSO0,"^",9),PSOIDD=$P(PSO0,"^",13)
40 I '$P(PSO0,"^",2)!('PSODR)!('PSOPR) Q
41 I $D(^PS(55,$P(PSO0,"^",2),0)) D:$P($G(^PS(55,$P(PSO0,"^",2),0)),"^",6)'=2 EN^PSOHLUP($P(PSO0,"^",2))
42 S PSOST=$P($G(^PSRX(PSORXX,"STA")),"^"),PSOPN=$P($G(^PSRX(PSORXX,"OR1")),"^",2)
43 I '$D(PSOACT) D ODT I PSODT<PSOBEGIN Q
44 I $D(PSOACT) Q:PSOST>10&(PSOST<16)
45 S PSORS="" I PSOFD=+$P(PSO2,"^",2),+$P(PSO2,"^",15) S PSORS="R"
46 I 'PSOFD S PSOFD=$P(PSO0,"^",13) F PSOJ=0:0 S PSOJ=$O(^PSRX(PSORXX,1,PSOJ)) Q:'PSOJ I $D(^(PSOJ,0)),^(0)>PSOFD S PSOFD=+^(0)
47 S PSOX=$S($D(^PSDRUG(PSODR,0)):$P(^(0),"^"),1:"NOT ON FILE"),PSODR=PSODR_";"_PSOX
48 S PSOX=$G(^VA(200,PSOPR,0)) S PSOPR=PSOPR_";"_$P(PSOX,"^")
49 S PSOX="A;ACTIVE" S:$D(^PS(52.4,PSORXX,0)) PSOX="N;NON-VERIFIED" S:$O(^PS(52.5,"B",PSORXX,0))&($G(^PS(52.5,+$O(^PS(52.5,"B",PSORXX,0)),"P"))'=1) PSOX="S;SUSPENDED"
50 I PSOX["SUSPENDED",$G(ACS) S PSOX="S;ACTIVE/SUSP"
51 S:PSODT<DT PSOX="E;EXPIRED" S:PSOST=4 PSOX="N;NON-VERIFIED" S:PSOST=3!(PSOST=16) PSOX="H;HOLD"
52 S:PSOST=12!(PSOST=14)!(PSOST=15) PSOX="DC;DISCONTINUED"
53 S PSOCF=+$P(PSO0,"^",17)*(+$P(PSO0,"^",7)) ; Cost/Fill
54 S PSORFL=0 F PSOJ=0:0 S PSORFL=$O(^PSRX(PSORXX,1,PSORFL)) Q:PSORFL'>0 S PSOREF=PSOREF-1
55 F PSOJ=9999999-PSOFD:.0001 Q:'$D(^TMP("PSOO",$J,PSOJ))
56 S ^TMP("PSOO",$J,PSOJ,0)=PSOIDD_"^"_PSOFD_"^"_PSODR_"^"_PSOPR_"^"_PSOX_"^"_$P(PSO0,"^")_"^"_$P(PSO0,"^",7)_"^"_PSOREF_"^"_PSORXX_"^"_PSOCF_"^"_PSODT_"^"_PSOPN
57 S:PSORS="R" ^TMP("PSOO",$J,PSOJ,0)=^TMP("PSOO",$J,PSOJ,0)_"^"_PSORS
58 I '$P(^PSRX(PSORXX,"SIG"),"^",2) D SIG Q
59 F I=0:0 S I=$O(^PSRX(PSORXX,"SIG1",I)) Q:'I S ^TMP("PSOO",$J,PSOJ,I,0)=^PSRX(PSORXX,"SIG1",I,0)
60 Q
61SIG ;formats backdoor SIG
62 S X=$P(^PSRX(PSORXX,"SIG"),"^") D SIGONE^PSOHELP S SIG=$E($G(INS1),2,250),ENT=1
63 F SG=1:1:$L(SIG) S:$L($G(^TMP("PSOO",$J,PSOJ,ENT,0))_" "_$P(SIG," ",SG))>80 ENT=ENT+1 S:$P(SIG," ",SG)'="" ^TMP("PSOO",$J,PSOJ,ENT,0)=$G(^TMP("PSOO",$J,PSOJ,ENT,0))_" "_$P(SIG," ",SG)
64 K SIG,ENT,SG,X Q
65ODT ;canceled or expiration date
66 I +PSOST=12!(PSOST=14)!(PSOST=15) D Q
67 .I $P(^PSRX(PSORXX,3),"^",5) S PSODT=$P(^PSRX(PSORXX,3),"^",5) Q
68 .S PSODT=0 F PSOJ=0:0 S PSOJ=$O(^PSRX(PSORXX,"A",PSOJ)) Q:PSOJ'>0 I $D(^(PSOJ,0)),$P(^(0),"^",2)="C",+$P(^(0),"^")>PSODT S PSODT=+$P(^(0),"^")
69 S PSODT=+$P(PSO2,"^",6)
70 Q
71ACS ;call from OE/RR to get the new active/susp status
72 S ACS=1 D EN
73 Q
Note: See TracBrowser for help on using the repository browser.