- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOBUILD.m
r613 r623 1 PSOBUILD ;IHS/DSD/JCM - BUILD ARRAY OF PATIENTS CURRENT MEDS [ 07/15/96 5:25 PM ] ;6/21/07 8:20am2 ;;7.0;OUTPATIENT PHARMACY;**23,82,119,132,235,206**;DEC 1997;Build 39 3 4 5 6 7 8 START 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 END 26 27 INIT 28 29 30 31 32 33 INITX 34 35 36 BUILD 37 38 BUILDX 39 40 GET 41 42 43 44 45 46 47 I PSOST0<12!(PSOST0=16),PSOEXPDT<DT D:$P(PSORX0,"^",15)'=1148 49 50 51 52 53 54 55 56 57 58 GT1 59 60 61 62 63 I 'CLOZPT,($P(PSODRUG0,"^",3)["A")&($P(PSODRUG0,"^",3)'["B")S PSOSTN=PSOSTN_"B",PSOSTF=PSOSTF_"B"64 K CLOZPT I ($P(PSODRUG0,"^",3)["W")!($P(PSODRUG0,"^",3)[1)!($P(PSODRUG0,"^",3)[2)S PSOSTN=PSOSTN_"C"65 66 67 68 69 70 71 BARC 72 73 74 75 76 77 GETX 78 STAT 79 80 81 82 FSTA 83 84 85 86 EOJ 87 88 INPAT(PSODFN) 89 90 91 92 1 PSOBUILD ;IHS/DSD/JCM - BUILD ARRAY OF PATIENTS CURRENT MEDS [ 07/15/96 5:25 PM ] 2 ;;7.0;OUTPATIENT PHARMACY;**23,82,119,132,235**;DEC 1997 3 ;External reference ^PS(50.606 supported by DBIA 2174 4 ;External reference ^PS(50.7 supported by DBIA 2223 5 ;External reference ^PS(55 supported by DBIA 2228 6 ;External reference ^PSDRUG( supported by DBIA 221 7 ; Input variables: PSODFN,DT,PSODTCUT 8 START N ORD K PSOSD I '$D(PSODFN)!('$D(DT)) G END 9 D EOJ,INIT G:PSOQFLG END D BUILD 10 S STA="ACTIVE^NON-VERIFIED^REFILL^HOLD^NON-VERIFIED^ACTIVE^^^^^^ACTIVE^DISCONTINUED^^DISCONTINUED^DISCONTINUED^HOLD" 11 S DRG="" F I=0:0 S DRG=$O(PSOSD(DRG)) Q:DRG="" I $G(PSOSD(DRG))]"" S PSOSD($P(STA,"^",$P(PSOSD(DRG),"^",2)+1),DRG)=PSOSD(DRG) D K PSOSD(DRG) 12 .S $P(PSOSD($P(STA,"^",$P(PSOSD(DRG),"^",2)+1),DRG),"^",9)=$G(^TMP("PS",$J,$P(STA,"^",$P(PSOSD(DRG),"^",2)+1),DRG)) 13 F PEN=0:0 S PEN=$O(^PS(52.41,"P",PSODFN,PEN)) Q:'PEN S ORD=^PS(52.41,PEN,0),PSOOI=$P(ORD,"^",8),PSODD=+$P(ORD,"^",9) D:$P(ORD,"^",3)'="DC"&($P(ORD,"^",3)'="DE")&($P(ORD,"^",3)'="HD") 14 .S DRG=$S(PSODD:$P($G(^PSDRUG(PSODD,0)),"^"),+PSOOI&('PSODD):$P(^PS(50.7,+PSOOI,0),"^")_" "_$P(^PS(50.606,$P(^PS(50.7,+PSOOI,0),"^",2),0),"^"),1:"") Q:DRG']"" 15 .I $D(PSOSD("PENDING",DRG)) S DRG=DRG_"^"_PEN 16 .S PSOSD("PENDING",DRG)="*****^17^Z^Z^"_$S(PSODD:$P(^PSDRUG(PSODD,0),"^",2),1:"")_"^"_$P(^PS(52.41,PEN,0),"^",11)_"^"_$S($G(^PSDRUG(PSODD,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:"") 17 .S PSOSD("PENDING",DRG)=PSOSD("PENDING",DRG)_"^"_$P(ORD,"^",10)_"^"_$P(ORD,"^",6)_"^"_PEN_"^"_$S($G(PSODD):$G(PSODD),1:""),PSOSD=+$G(PSOSD)+1 K PSOOI,PSODD 18 F NVA=0:0 S NVA=$O(^PS(55,PSODFN,"NVA",NVA)) Q:'NVA S NON=^PS(55,PSODFN,"NVA",NVA,0) D:'$P(^PS(55,PSODFN,"NVA",NVA,0),"^",7) 19 .S PSODD=$P(NON,"^",2),PSOOI=$P(NON,"^") 20 .S DRG=$S(PSODD:$P($G(^PSDRUG(PSODD,0)),"^"),+PSOOI&('PSODD):$P(^PS(50.7,+PSOOI,0),"^")_" "_$P(^PS(50.606,$P(^PS(50.7,+PSOOI,0),"^",2),0),"^"),1:"") 21 .I $D(PSOSD("ZNONVA",DRG)) S DRG=DRG_"^"_NVA 22 .S PSOSD("ZNONVA",DRG)="****^9^Z^Z^"_$S($P(NON,"^",2):$P(^PSDRUG($P(NON,"^",2),0),"^",2),1:"")_"^"_$P(NON,"^",3)_"^^"_$P(NON,"^",5)_"^"_$P(NON,"^",10)_"^"_NVA_"^"_$P(NON,"^",2) 23 .I $P(NON,"^",2) S $P(PSOSD("ZNONVA",DRG),"^",7)=$S($G(^PSDRUG(PSODD,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:"") 24 .S PSOSD=+$G(PSOSD)+1 25 END D EOJ 26 Q 27 INIT ; 28 K PSOSD,PSOMED S PSOQFLG=0,U="^",PSOBUILD("COUNT")=0 G:$D(PSODTCUT) INITX 29 I '$D(^PS(53,"B","OUTPATIENT")) S PSOQFLG=1 G INITX 30 S PSOX=$O(^PS(53,"B","OUTPATIENT","")) I 'PSOX S PSOQFLG=1 G INITX 31 ;S DAYS=$S($D(DAYS360):360,1:45),X2=-$S($P($G(^PS(53,PSOX,0)),"^",3)+15>DAYS:$P($G(^(0)),"^",3)+15,1:DAYS),X1=DT D C^%DTC S PSODTCUT=X 32 S X2=-120,X1=DT D C^%DTC S PSODTCUT=X 33 INITX K X,X1,X2,PSOX 34 Q 35 ; 36 BUILD ;build profiles 37 F PSOEXPDT=(PSODTCUT-1):0 S PSOEXPDT=$O(^PS(55,PSODFN,"P","A",PSOEXPDT)) Q:'PSOEXPDT F PSOBUILD("RX")=0:0 S PSOBUILD("RX")=$O(^PS(55,PSODFN,"P","A",PSOEXPDT,PSOBUILD("RX"))) Q:'PSOBUILD("RX") I $D(^PSRX(PSOBUILD("RX"),0)) D GET 38 BUILDX I PSOBUILD("COUNT")>0 S PSOSD=PSOBUILD("COUNT") 39 Q 40 GET ;data for profiles 41 Q:'$P(^PSRX(PSOBUILD("RX"),0),"^",2) 42 S (PSOSTF,PSOSTN)="",PSORX0=^PSRX(PSOBUILD("RX"),0),PSOST0=+^PSRX(PSOBUILD("RX"),"STA"),$P(PSORX0,"^",15)=PSOST0 43 G:PSOST0=13 GETX S PSORX2=$G(^PSRX(PSOBUILD("RX"),2)) 44 S PSORX3=$G(^PSRX(PSOBUILD("RX"),3)) S:PSORX3="" PSORX3=$P(PSORX2,"^",2) 45 S PSODRG=+$P(PSORX0,"^",6) G:'$D(^PSDRUG(PSODRG,0)) GETX S PSODRUG0=^PSDRUG(PSODRG,0),PSOVACL=$P(PSODRUG0,"^",2),PSODYS=$P(PSORX0,"^",8) 46 ; 47 I PSOST0<12,PSOEXPDT<DT D:$P(PSORX0,"^",15)'=11 48 .S PSOST0=11,$P(PSORX0,"^",15)=11 N DIE,DIC,DR,DA,PSOBEXDA S DIE=52,(DA,PSOBEXDA)=PSOBUILD("RX"),DR="100////11" D ^DIE K DIE,DIC,DR 49 .D ECAN^PSOUTL(DA) K DA 50 .S STAT="SC",PHARMST="ZE",COMM="Medication Expired on "_$E(PSOEXPDT,4,5)_"/"_$E(PSOEXPDT,6,7)_"/"_$E(PSOEXPDT,2,3) D EN^PSOHLSN1(PSOBEXDA,STAT,PHARMST,COMM) K COMM,STAT,PHARMST,PSOBEXDA 51 I PSOST0=12,PSOEXPDT<DT S PSOST0=12 52 I PSOST0=5 D G GT1 53 .I $O(^PS(52.5,"B",PSOBUILD("RX"),0)),'$D(^PS(52.5,+$O(^(0)),0)) D Q 54 ..S PSOST0=0 D FSTA 55 ..K ^PS(52.5,"B",PSOBUILD("RX"),$O(^PS(52.5,"B",PSOBUILD("RX"),0))) 56 .I '$O(^PS(52.5,"B",PSOBUILD("RX"),0)) S PSOST0=0 D FSTA 57 I 'PSOST0 D STAT 58 GT1 G GETX:$D(NOEXP)&(PSOST0=11) 59 I $D(^PSDRUG(PSODRG,"I")),^("I")]"",DT>^("I") S PSOSTN=PSOSTN_"A" I $P($G(PSOPAR),"^",11)']"" S PSOSTF=PSOSTF_"A" 60 S PSONDF=$S($G(^PSDRUG(PSODRG,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0) 61 I $P($G(^PSDRUG(PSODRG,2)),"^",3)'["O" S PSOSTN=PSOSTN_"M" 62 S CLOZPT=$S($P($G(^PSDRUG(PSODRG,"CLOZ1")),"^")="PSOCLO1":1,1:0) 63 I 'CLOZPT,$P(PSODRUG0,"^",3)["A",$P(PSODRUG0,"^",3)'["B" S PSOSTN=PSOSTN_"B",PSOSTF=PSOSTF_"B" 64 K CLOZPT I $P(PSODRUG0,"^",3)["W" S PSOSTN=PSOSTN_"C" 65 I $D(^PS(53,+$P(PSORX0,"^",3),0)),'$P(^(0),"^",5) S PSOSTN=PSOSTN_"D" 66 I PSOST0=1 S PSOSTN=PSOSTN_"E" 67 S PSOLC=$P(PSORX0,"^"),PSOLC=$E(PSOLC,$L(PSOLC)) I $A(PSOLC)>90 S PSOSTN=PSOSTN_"F" 68 I PSOST0,PSOST0'=2,PSOST0'=6 S PSOSTF=PSOSTF_"Z" 69 I $G(PSORX("BAR CODE")),PSOST0,PSOST0'=2,PSOST0'=5,PSOST0'=6,PSOST0'=11,PSOST0'=12 S PSOSTN=PSOSTN_"Z" G BARC 70 I PSOST0,PSOST0'=2,PSOST0'=5,PSOST0'=6,PSOST0'=11,PSOST0'=12,PSOST0'=14 S PSOSTN=PSOSTN_"Z" 71 BARC S PSORFRM=$P(PSORX0,"^",9) F PSOJ=0:0 S PSOJ=$O(^PSRX(PSOBUILD("RX"),1,PSOJ)) Q:'PSOJ S PSORFRM=PSORFRM-1 72 S:PSORFRM<0 PSORFRM=0 S:PSORFRM=0 PSOSTF=PSOSTF_"G" 73 S PSODRUGN=$P(PSODRUG0,"^") I $D(PSOSD(PSODRUGN)),PSOST0>10 Q:$P(PSOSD(PSODRUGN),"^",2)<11 Q:$P(PSOSD(PSODRUGN),"^",2)>10&($P(PSORX0,"^",13)<$P(^PSRX(+$P(PSOSD(PSODRUGN),"^"),0),"^",13)) 74 S:'$D(PSOSD(PSODRUGN)) PSOBUILD("COUNT")=PSOBUILD("COUNT")+1 75 I $D(PSOSD(PSODRUGN)),$P(PSOSD(PSODRUGN),"^",2)<10,PSOST0<10 S PSOSD(PSODRUGN_"^"_PSOBUILD("RX"))=PSOBUILD("RX")_"^"_PSOST0_"^"_PSOSTN_"^"_PSOSTF_"^"_PSOVACL_"^"_PSORFRM_"^"_PSONDF_"^"_PSODYS,PSOBUILD("COUNT")=PSOBUILD("COUNT")+1 76 E S PSOSD(PSODRUGN)=PSOBUILD("RX")_"^"_PSOST0_"^"_PSOSTN_"^"_PSOSTF_"^"_PSOVACL_"^"_PSORFRM_"^"_PSONDF_"^"_PSODYS 77 GETX Q 78 STAT N X S X=+$O(^PS(52.5,"B",PSOBUILD("RX"),0)) 79 I X,$D(^PS(52.5,X,0)),$P($G(^PS(52.5,X,0)),"^",7)'="X",'$G(^PS(52.5,X,"P")) S PSOST0=5 80 I PSOST0 D FSTA 81 Q 82 FSTA S $P(PSORX0,"^",15)=PSOST0 83 N DIE,DR,DA S DIE=52,DA=PSOBUILD("RX"),DR="100////"_PSOST0 D ^DIE K DIE,DR,DA 84 Q 85 ; 86 EOJ K ORD,PSOX,PSOEXPDT,PSODRG,PSODRUG0,PSOLC,PSONDF,PSOQFLG,PSORFRM,PSORX0,PSORX2,PSORX3,PSOST0,PSOSTF,PSOSTN,PSOJ,PSODRUGN,PSOVACL,PSOBUILD,PSODYS,PEN,DRG,NON,NVA 87 Q 88 INPAT(PSODFN) ;entry point for inpat meds to view patient's outpat. meds 89 D FULL^VALM1 90 S INPAT=1,X2=-120,X1=DT D C^%DTC S PSODTCUT=X D START,^PSODSPL 91 K PSOSD,DDH,PSCNT,PSOCT,PSODD,PSOOI,PSOPAR,PSOSTA,STP,STR,PSODTCUT,PSODFN,INPAT,DRG 92 Q
Note:
See TracChangeset
for help on using the changeset viewer.
