- PSOBUILD ;IHS/DSD/JCM - BUILD ARRAY OF PATIENTS CURRENT MEDS;29-May-2012 14:40;PLS
- ;;7.0;OUTPATIENT PHARMACY;**23,82,119,132,1006,1013,235,206,1010,1015**;DEC 1997;Build 62
- ;External reference ^PS(50.606 supported by DBIA 2174
- ;External reference ^PS(50.7 supported by DBIA 2223
- ;External reference ^PS(55 supported by DBIA 2228
- ;External reference ^PSDRUG( supported by DBIA 221
- ;
- ; Modified - IHS/MSC/PLS - 10/18/07 - Support for Outside Pharmacy
- ; - 11/03/11 - Support of TallMan lettering
- ; Input variables: PSODFN,DT,PSODTCUT
- START N ORD K PSOSD I '$D(PSODFN)!('$D(DT)) G END
- N DRGZ ;IHS/MSC/PLS - 11/03/2011
- D EOJ,INIT G:PSOQFLG END D BUILD
- S STA="ACTIVE^NON-VERIFIED^REFILL^HOLD^NON-VERIFIED^ACTIVE^^^^^^ACTIVE^DISCONTINUED^^DISCONTINUED^DISCONTINUED^HOLD"
- 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)
- .S $P(PSOSD($P(STA,"^",$P(PSOSD(DRG),"^",2)+1),DRG),"^",9)=$G(^TMP("PS",$J,$P(STA,"^",$P(PSOSD(DRG),"^",2)+1),DRG))
- .S PSOSD($P(STA,"^",$P(PSOSD(DRG),"^",2)+1),DRG,"IHS")=$G(PSOSD(DRG,"IHS"))
- 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")
- .;IHS/MSC/PLS - 11/03/2011
- .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']""
- .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']"" S DRGZ=DRG,DRG=$$UP^XLFSTR(DRG)
- .I $D(PSOSD("PENDING",DRG)) S DRG=DRG_"^"_PEN
- .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:"")
- .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
- .S PSOSD("PENDING",DRG,"IHS")=DRGZ
- 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)
- .S PSODD=$P(NON,"^",2),PSOOI=$P(NON,"^")
- .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:"")
- .;IHS/MSC/PLS - 11/03/11
- .S DRGZ=DRG,DRG=$$UP^XLFSTR(DRG)
- .I $D(PSOSD("ZNONVA",DRG)) S DRG=DRG_"^"_NVA
- .S PSOSD("ZNONVA",DRG,"IHS")=DRGZ
- .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)
- .I $P(NON,"^",2) S $P(PSOSD("ZNONVA",DRG),"^",7)=$S($G(^PSDRUG(PSODD,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:"")
- .S PSOSD=+$G(PSOSD)+1
- ;IHS/MSC/PLS - 10/18/07; 11/08/11 - TallMan
- S DRG="" F S DRG=$O(PSOSD("ACTIVE",DRG)) Q:DRG="" D
- .I $P($G(^PSRX(+PSOSD("ACTIVE",DRG),999999921)),U,3) D
- ..S PSOSD("ACTIVE OTHER PHARMACY",DRG)=PSOSD("ACTIVE",DRG)
- ..S PSOSD("ACTIVE OTHER PHARMACY",DRG,"IHS")=PSOSD("ACTIVE",DRG,"IHS")
- ..K PSOSD("ACTIVE",DRG)
- END D EOJ
- Q
- INIT ;
- K PSOSD,PSOMED S PSOQFLG=0,U="^",PSOBUILD("COUNT")=0 G:$D(PSODTCUT) INITX
- I '$D(^PS(53,"B","OUTPATIENT")) S PSOQFLG=1 G INITX
- S PSOX=$O(^PS(53,"B","OUTPATIENT","")) I 'PSOX S PSOQFLG=1 G INITX
- ;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
- S X2=-120,X1=DT D C^%DTC S PSODTCUT=X
- INITX K X,X1,X2,PSOX
- Q
- ;
- BUILD ;build profiles
- 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
- BUILDX I PSOBUILD("COUNT")>0 S PSOSD=PSOBUILD("COUNT")
- Q
- GET ;data for profiles
- Q:'$P(^PSRX(PSOBUILD("RX"),0),"^",2)
- S (PSOSTF,PSOSTN)="",PSORX0=^PSRX(PSOBUILD("RX"),0),PSOST0=+^PSRX(PSOBUILD("RX"),"STA"),$P(PSORX0,"^",15)=PSOST0
- G:PSOST0=13 GETX S PSORX2=$G(^PSRX(PSOBUILD("RX"),2))
- S PSORX3=$G(^PSRX(PSOBUILD("RX"),3)) S:PSORX3="" PSORX3=$P(PSORX2,"^",2)
- S PSODRG=+$P(PSORX0,"^",6) G:'$D(^PSDRUG(PSODRG,0)) GETX S PSODRUG0=^PSDRUG(PSODRG,0),PSOVACL=$P(PSODRUG0,"^",2),PSODYS=$P(PSORX0,"^",8)
- ;
- I PSOST0<12!(PSOST0=16),PSOEXPDT<DT D:$P(PSORX0,"^",15)'=11
- .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
- .D ECAN^PSOUTL(DA) K DA
- .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
- I PSOST0=12,PSOEXPDT<DT S PSOST0=12
- I PSOST0=5 D G GT1
- .I $O(^PS(52.5,"B",PSOBUILD("RX"),0)),'$D(^PS(52.5,+$O(^(0)),0)) D Q
- ..S PSOST0=0 D FSTA
- ..K ^PS(52.5,"B",PSOBUILD("RX"),$O(^PS(52.5,"B",PSOBUILD("RX"),0)))
- .I '$O(^PS(52.5,"B",PSOBUILD("RX"),0)) S PSOST0=0 D FSTA
- I 'PSOST0 D STAT
- GT1 G GETX:$D(NOEXP)&(PSOST0=11)
- I $D(^PSDRUG(PSODRG,"I")),^("I")]"",DT>^("I") S PSOSTN=PSOSTN_"A" I $P($G(PSOPAR),"^",11)']"" S PSOSTF=PSOSTF_"A"
- S PSONDF=$S($G(^PSDRUG(PSODRG,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)
- I $P($G(^PSDRUG(PSODRG,2)),"^",3)'["O" S PSOSTN=PSOSTN_"M"
- S CLOZPT=$S($P($G(^PSDRUG(PSODRG,"CLOZ1")),"^")="PSOCLO1":1,1:0)
- I 'CLOZPT,($P(PSODRUG0,"^",3)["A")&($P(PSODRUG0,"^",3)'["B") S PSOSTN=PSOSTN_"B",PSOSTF=PSOSTF_"B"
- K CLOZPT I ($P(PSODRUG0,"^",3)["W")!($P(PSODRUG0,"^",3)[1)!($P(PSODRUG0,"^",3)[2) S PSOSTN=PSOSTN_"C"
- I $D(^PS(53,+$P(PSORX0,"^",3),0)),'$P(^(0),"^",5) S PSOSTN=PSOSTN_"D"
- I PSOST0=1 S PSOSTN=PSOSTN_"E"
- S PSOLC=$P(PSORX0,"^"),PSOLC=$E(PSOLC,$L(PSOLC)) I $A(PSOLC)>90 S PSOSTN=PSOSTN_"F"
- I PSOST0,PSOST0'=2,PSOST0'=6 S PSOSTF=PSOSTF_"Z"
- I $G(PSORX("BAR CODE")),PSOST0,PSOST0'=2,PSOST0'=5,PSOST0'=6,PSOST0'=11,PSOST0'=12 S PSOSTN=PSOSTN_"Z" G BARC
- I PSOST0,PSOST0'=2,PSOST0'=5,PSOST0'=6,PSOST0'=11,PSOST0'=12,PSOST0'=14 S PSOSTN=PSOSTN_"Z"
- BARC S PSORFRM=$P(PSORX0,"^",9) F PSOJ=0:0 S PSOJ=$O(^PSRX(PSOBUILD("RX"),1,PSOJ)) Q:'PSOJ S PSORFRM=PSORFRM-1
- S:PSORFRM<0 PSORFRM=0 S:PSORFRM=0 PSOSTF=PSOSTF_"G"
- 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))
- S PSODRUGN=$$UP^XLFSTR($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))
- S:'$D(PSOSD(PSODRUGN)) PSOBUILD("COUNT")=PSOBUILD("COUNT")+1
- ; IHS/MSC/PLS - 11/08/11
- ;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
- ;E S PSOSD(PSODRUGN)=PSOBUILD("RX")_"^"_PSOST0_"^"_PSOSTN_"^"_PSOSTF_"^"_PSOVACL_"^"_PSORFRM_"^"_PSONDF_"^"_PSODYS
- I $D(PSOSD(PSODRUGN)),$P(PSOSD(PSODRUGN),"^",2)<10,PSOST0<10 D
- .S PSOSD(PSODRUGN_"^"_PSOBUILD("RX"))=PSOBUILD("RX")_"^"_PSOST0_"^"_PSOSTN_"^"_PSOSTF_"^"_PSOVACL_"^"_PSORFRM_"^"_PSONDF_"^"_PSODYS,PSOBUILD("COUNT")=PSOBUILD("COUNT")+1
- .S PSOSD(PSODRUGN_U_PSOBUILD("RX"),"IHS")=$P(PSODRUG0,U)
- E D
- .S PSOSD(PSODRUGN)=PSOBUILD("RX")_"^"_PSOST0_"^"_PSOSTN_"^"_PSOSTF_"^"_PSOVACL_"^"_PSORFRM_"^"_PSONDF_"^"_PSODYS
- .S PSOSD(PSODRUGN,"IHS")=$P(PSODRUG0,U)
- GETX Q
- STAT N X S X=+$O(^PS(52.5,"B",PSOBUILD("RX"),0))
- 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
- I PSOST0 D FSTA
- Q
- FSTA S $P(PSORX0,"^",15)=PSOST0
- N DIE,DR,DA S DIE=52,DA=PSOBUILD("RX"),DR="100////"_PSOST0 D ^DIE K DIE,DR,DA
- Q
- ;
- 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
- Q
- INPAT(PSODFN) ;entry point for inpat meds to view patient's outpat. meds
- D FULL^VALM1
- S INPAT=1,X2=-120,X1=DT D C^%DTC S PSODTCUT=X D START,^PSODSPL
- K PSOSD,DDH,PSCNT,PSOCT,PSODD,PSOOI,PSOPAR,PSOSTA,STP,STR,PSODTCUT,PSODFN,INPAT,DRG
- Q
- PSOBUILD ;IHS/DSD/JCM - BUILD ARRAY OF PATIENTS CURRENT MEDS;29-May-2012 14:40;PLS
- +1 ;;7.0;OUTPATIENT PHARMACY;**23,82,119,132,1006,1013,235,206,1010,1015**;DEC 1997;Build 62
- +2 ;External reference ^PS(50.606 supported by DBIA 2174
- +3 ;External reference ^PS(50.7 supported by DBIA 2223
- +4 ;External reference ^PS(55 supported by DBIA 2228
- +5 ;External reference ^PSDRUG( supported by DBIA 221
- +6 ;
- +7 ; Modified - IHS/MSC/PLS - 10/18/07 - Support for Outside Pharmacy
- +8 ; - 11/03/11 - Support of TallMan lettering
- +9 ; Input variables: PSODFN,DT,PSODTCUT
- START NEW ORD
- KILL PSOSD
- IF '$DATA(PSODFN)!('$DATA(DT))
- GOTO END
- +1 ;IHS/MSC/PLS - 11/03/2011
- NEW DRGZ
- +2 DO EOJ
- DO INIT
- IF PSOQFLG
- GOTO END
- DO BUILD
- +3 SET STA="ACTIVE^NON-VERIFIED^REFILL^HOLD^NON-VERIFIED^ACTIVE^^^^^^ACTIVE^DISCONTINUED^^DISCONTINUED^DISCONTINUED^HOLD"
- +4 SET DRG=""
- FOR I=0:0
- SET DRG=$ORDER(PSOSD(DRG))
- IF DRG=""
- QUIT
- IF $GET(PSOSD(DRG))]""
- SET PSOSD($PIECE(STA,"^",$PIECE(PSOSD(DRG),"^",2)+1),DRG)=PSOSD(DRG)
- Begin DoDot:1
- +5 SET $PIECE(PSOSD($PIECE(STA,"^",$PIECE(PSOSD(DRG),"^",2)+1),DRG),"^",9)=$GET(^TMP("PS",$JOB,$PIECE(STA,"^",$PIECE(PSOSD(DRG),"^",2)+1),DRG))
- +6 SET PSOSD($PIECE(STA,"^",$PIECE(PSOSD(DRG),"^",2)+1),DRG,"IHS")=$GET(PSOSD(DRG,"IHS"))
- End DoDot:1
- KILL PSOSD(DRG)
- +7 FOR PEN=0:0
- SET PEN=$ORDER(^PS(52.41,"P",PSODFN,PEN))
- IF 'PEN
- QUIT
- SET ORD=^PS(52.41,PEN,0)
- SET PSOOI=$PIECE(ORD,"^",8)
- SET PSODD=+$PIECE(ORD,"^",9)
- IF $PIECE(ORD,"^",3)'="DC"&($PIECE(ORD,"^",3)'="DE")&($PIECE(ORD,"^",3)'="HD")
- Begin DoDot:1
- +8 ;IHS/MSC/PLS - 11/03/2011
- +9 SET DRG=$SELECT(PSODD:$PIECE($GET(^PSDRUG(PSODD,0)),"^"),+PSOOI&('PSODD):$PIECE(^PS(50.7,+PSOOI,0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^PS(50.7,+PSOOI,0),"^",2),0),"^"),1:"")
- IF DRG']""
- QUIT
- +10 SET DRG=$SELECT(PSODD:$PIECE($GET(^PSDRUG(PSODD,0)),"^"),+PSOOI&('PSODD):$PIECE(^PS(50.7,+PSOOI,0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^PS(50.7,+PSOOI,0),"^",2),0),"^"),1:"")
- IF DRG']""
- QUIT
- SET DRGZ=DRG
- SET DRG=$$UP^XLFSTR(DRG)
- +11 IF $DATA(PSOSD("PENDING",DRG))
- SET DRG=DRG_"^"_PEN
- +12 SET PSOSD("PENDING",DRG)="*****^17^Z^Z^"_$SELECT(PSODD:$PIECE(^PSDRUG(PSODD,0),"^",2),1:"")_"^"_$PIECE(^PS(52.41,PEN,0),"^",11)_"^"_$SELECT($GET(^PSDRUG(PSODD,"ND"))]"":+^("ND")_"A"_$PIECE(^("ND"),"^",3),1:"")
- +13 SET PSOSD("PENDING",DRG)=PSOSD("PENDING",DRG)_"^"_$PIECE(ORD,"^",10)_"^"_$PIECE(ORD,"^",6)_"^"_PEN_"^"_$SELECT($GET">GET(PSODD):$GET">GET(PSODD),1:"")
- SET PSOSD=+$GET(PSOSD)+1
- KILL PSOOI,PSODD
- +14 SET PSOSD("PENDING",DRG,"IHS")=DRGZ
- End DoDot:1
- +15 FOR NVA=0:0
- SET NVA=$ORDER(^PS(55,PSODFN,"NVA",NVA))
- IF 'NVA
- QUIT
- SET NON=^PS(55,PSODFN,"NVA",NVA,0)
- IF '$PIECE(^PS(55,PSODFN,"NVA",NVA,0),"^",7)
- Begin DoDot:1
- +16 SET PSODD=$PIECE(NON,"^",2)
- SET PSOOI=$PIECE(NON,"^")
- +17 SET DRG=$SELECT(PSODD:$PIECE($GET(^PSDRUG(PSODD,0)),"^"),+PSOOI&('PSODD):$PIECE(^PS(50.7,+PSOOI,0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^PS(50.7,+PSOOI,0),"^",2),0),"^"),1:"")
- +18 ;IHS/MSC/PLS - 11/03/11
- +19 SET DRGZ=DRG
- SET DRG=$$UP^XLFSTR(DRG)
- +20 IF $DATA(PSOSD("ZNONVA",DRG))
- SET DRG=DRG_"^"_NVA
- +21 SET PSOSD("ZNONVA",DRG,"IHS")=DRGZ
- +22 SET PSOSD("ZNONVA",DRG)="****^9^Z^Z^"_$SELECT($PIECE(NON,"^",2):$PIECE(^PSDRUG($PIECE(NON,"^",2),0),"^",2),1:"")_"^"_$PIECE(NON,"^",3)_"^^"_$PIECE(NON,"^",5)_"^"_$PIECE(NON,"^",10)_"^"_NVA_"^"_$PIECE(NON,"^",2)
- +23 IF $PIECE(NON,"^",2)
- SET $PIECE(PSOSD("ZNONVA",DRG),"^",7)=$SELECT($GET(^PSDRUG(PSODD,"ND"))]"":+^("ND")_"A"_$PIECE(^("ND"),"^",3),1:"")
- +24 SET PSOSD=+$GET(PSOSD)+1
- End DoDot:1
- +25 ;IHS/MSC/PLS - 10/18/07; 11/08/11 - TallMan
- +26 SET DRG=""
- FOR
- SET DRG=$ORDER(PSOSD("ACTIVE",DRG))
- IF DRG=""
- QUIT
- Begin DoDot:1
- +27 IF $PIECE($GET(^PSRX(+PSOSD("ACTIVE",DRG),999999921)),U,3)
- Begin DoDot:2
- +28 SET PSOSD("ACTIVE OTHER PHARMACY",DRG)=PSOSD("ACTIVE",DRG)
- +29 SET PSOSD("ACTIVE OTHER PHARMACY",DRG,"IHS")=PSOSD("ACTIVE",DRG,"IHS")
- +30 KILL PSOSD("ACTIVE",DRG)
- End DoDot:2
- End DoDot:1
- END DO EOJ
- +1 QUIT
- INIT ;
- +1 KILL PSOSD,PSOMED
- SET PSOQFLG=0
- SET U="^"
- SET PSOBUILD("COUNT")=0
- IF $DATA(PSODTCUT)
- GOTO INITX
- +2 IF '$DATA(^PS(53,"B","OUTPATIENT"))
- SET PSOQFLG=1
- GOTO INITX
- +3 SET PSOX=$ORDER(^PS(53,"B","OUTPATIENT",""))
- IF 'PSOX
- SET PSOQFLG=1
- GOTO INITX
- +4 ;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
- +5 SET X2=-120
- SET X1=DT
- DO C^%DTC
- SET PSODTCUT=X
- INITX KILL X,X1,X2,PSOX
- +1 QUIT
- +2 ;
- BUILD ;build profiles
- +1 FOR PSOEXPDT=(PSODTCUT-1):0
- SET PSOEXPDT=$ORDER(^PS(55,PSODFN,"P","A",PSOEXPDT))
- IF 'PSOEXPDT
- QUIT
- FOR PSOBUILD("RX")=0:0
- SET PSOBUILD("RX")=$ORDER(^PS(55,PSODFN,"P","A",PSOEXPDT,PSOBUILD("RX")))
- IF 'PSOBUILD("RX")
- QUIT
- IF $DATA(^PSRX(PSOBUILD("RX"),0))
- DO GET
- BUILDX IF PSOBUILD("COUNT")>0
- SET PSOSD=PSOBUILD("COUNT")
- +1 QUIT
- GET ;data for profiles
- +1 IF '$PIECE(^PSRX(PSOBUILD("RX"),0),"^",2)
- QUIT
- +2 SET (PSOSTF,PSOSTN)=""
- SET PSORX0=^PSRX(PSOBUILD("RX"),0)
- SET PSOST0=+^PSRX(PSOBUILD("RX"),"STA")
- SET $PIECE(PSORX0,"^",15)=PSOST0
- +3 IF PSOST0=13
- GOTO GETX
- SET PSORX2=$GET(^PSRX(PSOBUILD("RX"),2))
- +4 SET PSORX3=$GET(^PSRX(PSOBUILD("RX"),3))
- IF PSORX3=""
- SET PSORX3=$PIECE(PSORX2,"^",2)
- +5 SET PSODRG=+$PIECE(PSORX0,"^",6)
- IF '$DATA(^PSDRUG(PSODRG,0))
- GOTO GETX
- SET PSODRUG0=^PSDRUG(PSODRG,0)
- SET PSOVACL=$PIECE(PSODRUG0,"^",2)
- SET PSODYS=$PIECE(PSORX0,"^",8)
- +6 ;
- +7 IF PSOST0<12!(PSOST0=16)
- IF PSOEXPDT<DT
- IF $PIECE(PSORX0,"^",15)'=11
- Begin DoDot:1
- +8 SET PSOST0=11
- SET $PIECE(PSORX0,"^",15)=11
- NEW DIE,DIC,DR,DA,PSOBEXDA
- SET DIE=52
- SET (DA,PSOBEXDA)=PSOBUILD("RX")
- SET DR="100////11"
- DO ^DIE
- KILL DIE,DIC,DR
- +9 DO ECAN^PSOUTL(DA)
- KILL DA
- +10 SET STAT="SC"
- SET PHARMST="ZE"
- SET COMM="Medication Expired on "_$EXTRACT(PSOEXPDT,4,5)_"/"_$EXTRACT(PSOEXPDT,6,7)_"/"_$EXTRACT(PSOEXPDT,2,3)
- DO EN^PSOHLSN1(PSOBEXDA,STAT,PHARMST,COMM)
- KILL COMM,STAT,PHARMST,PSOBEXDA
- End DoDot:1
- +11 IF PSOST0=12
- IF PSOEXPDT<DT
- SET PSOST0=12
- +12 IF PSOST0=5
- Begin DoDot:1
- +13 IF $ORDER(^PS(52.5,"B",PSOBUILD("RX"),0))
- IF '$DATA(^PS(52.5,+$ORDER(^(0)),0))
- Begin DoDot:2
- +14 SET PSOST0=0
- DO FSTA
- +15 KILL ^PS(52.5,"B",PSOBUILD("RX"),$ORDER(^PS(52.5,"B",PSOBUILD("RX"),0)))
- End DoDot:2
- QUIT
- +16 IF '$ORDER(^PS(52.5,"B",PSOBUILD("RX"),0))
- SET PSOST0=0
- DO FSTA
- End DoDot:1
- GOTO GT1
- +17 IF 'PSOST0
- DO STAT
- GT1 IF $DATA(NOEXP)&(PSOST0=11)
- GOTO GETX
- +1 IF $DATA(^PSDRUG(PSODRG,"I"))
- IF ^("I")]""
- IF DT>^("I")
- SET PSOSTN=PSOSTN_"A"
- IF $PIECE($GET(PSOPAR),"^",11)']""
- SET PSOSTF=PSOSTF_"A"
- +2 SET PSONDF=$SELECT($GET(^PSDRUG(PSODRG,"ND"))]"":+^("ND")_"A"_$PIECE(^("ND"),"^",3),1:0)
- +3 IF $PIECE($GET(^PSDRUG(PSODRG,2)),"^",3)'["O"
- SET PSOSTN=PSOSTN_"M"
- +4 SET CLOZPT=$SELECT($PIECE($GET(^PSDRUG(PSODRG,"CLOZ1")),"^")="PSOCLO1":1,1:0)
- +5 IF 'CLOZPT
- IF ($PIECE(PSODRUG0,"^",3)["A")&($PIECE(PSODRUG0,"^",3)'["B")
- SET PSOSTN=PSOSTN_"B"
- SET PSOSTF=PSOSTF_"B"
- +6 KILL CLOZPT
- IF ($PIECE(PSODRUG0,"^",3)["W")!($PIECE(PSODRUG0,"^",3)[1)!($PIECE(PSODRUG0,"^",3)[2)
- SET PSOSTN=PSOSTN_"C"
- +7 IF $DATA(^PS(53,+$PIECE(PSORX0,"^",3),0))
- IF '$PIECE(^(0),"^",5)
- SET PSOSTN=PSOSTN_"D"
- +8 IF PSOST0=1
- SET PSOSTN=PSOSTN_"E"
- +9 SET PSOLC=$PIECE(PSORX0,"^")
- SET PSOLC=$EXTRACT(PSOLC,$LENGTH(PSOLC))
- IF $ASCII(PSOLC)>90
- SET PSOSTN=PSOSTN_"F"
- +10 IF PSOST0
- IF PSOST0'=2
- IF PSOST0'=6
- SET PSOSTF=PSOSTF_"Z"
- +11 IF $GET(PSORX("BAR CODE"))
- IF PSOST0
- IF PSOST0'=2
- IF PSOST0'=5
- IF PSOST0'=6
- IF PSOST0'=11
- IF PSOST0'=12
- SET PSOSTN=PSOSTN_"Z"
- GOTO BARC
- +12 IF PSOST0
- IF PSOST0'=2
- IF PSOST0'=5
- IF PSOST0'=6
- IF PSOST0'=11
- IF PSOST0'=12
- IF PSOST0'=14
- SET PSOSTN=PSOSTN_"Z"
- BARC SET PSORFRM=$PIECE(PSORX0,"^",9)
- FOR PSOJ=0:0
- SET PSOJ=$ORDER(^PSRX(PSOBUILD("RX"),1,PSOJ))
- IF 'PSOJ
- QUIT
- SET PSORFRM=PSORFRM-1
- +1 IF PSORFRM<0
- SET PSORFRM=0
- IF PSORFRM=0
- SET PSOSTF=PSOSTF_"G"
- +2 SET PSODRUGN=$PIECE(PSODRUG0,"^")
- IF $DATA(PSOSD(PSODRUGN))
- IF PSOST0>10
- IF $PIECE(PSOSD(PSODRUGN),"^",2)<11
- QUIT
- IF $PIECE(PSOSD(PSODRUGN),"^",2)>10&($PIECE(PSORX0,"^",13)<$PIECE(^PSRX(+$PIECE(PSOSD(PSODRUGN),"^"),0),"^",13))
- QUIT
- +3 SET PSODRUGN=$$UP^XLFSTR($PIECE(PSODRUG0,"^"))
- IF $DATA(PSOSD(PSODRUGN))
- IF PSOST0>10
- IF $PIECE(PSOSD(PSODRUGN),"^",2)<11
- QUIT
- IF $PIECE(PSOSD(PSODRUGN),"^",2)>10&($PIECE(PSORX0,"^",13)<$PIECE(^PSRX(+$PIECE(PSOSD(PSODRUGN),"^"),0),"^",13))
- QUIT
- +4 IF '$DATA(PSOSD(PSODRUGN))
- SET PSOBUILD("COUNT")=PSOBUILD("COUNT")+1
- +5 ; IHS/MSC/PLS - 11/08/11
- +6 ;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
- +7 ;E S PSOSD(PSODRUGN)=PSOBUILD("RX")_"^"_PSOST0_"^"_PSOSTN_"^"_PSOSTF_"^"_PSOVACL_"^"_PSORFRM_"^"_PSONDF_"^"_PSODYS
- +8 IF $DATA(PSOSD(PSODRUGN))
- IF $PIECE(PSOSD(PSODRUGN),"^",2)<10
- IF PSOST0<10
- Begin DoDot:1
- +9 SET PSOSD(PSODRUGN_"^"_PSOBUILD("RX"))=PSOBUILD("RX")_"^"_PSOST0_"^"_PSOSTN_"^"_PSOSTF_"^"_PSOVACL_"^"_PSORFRM_"^"_PSONDF_"^"_PSODYS
- SET PSOBUILD("COUNT")=PSOBUILD("COUNT")+1
- +10 SET PSOSD(PSODRUGN_U_PSOBUILD("RX"),"IHS")=$PIECE(PSODRUG0,U)
- End DoDot:1
- +11 IF '$TEST
- Begin DoDot:1
- +12 SET PSOSD(PSODRUGN)=PSOBUILD("RX")_"^"_PSOST0_"^"_PSOSTN_"^"_PSOSTF_"^"_PSOVACL_"^"_PSORFRM_"^"_PSONDF_"^"_PSODYS
- +13 SET PSOSD(PSODRUGN,"IHS")=$PIECE(PSODRUG0,U)
- End DoDot:1
- GETX QUIT
- STAT NEW X
- SET X=+$ORDER(^PS(52.5,"B",PSOBUILD("RX"),0))
- +1 IF X
- IF $DATA(^PS(52.5,X,0))
- IF $PIECE($GET(^PS(52.5,X,0)),"^",7)'="X"
- IF '$GET(^PS(52.5,X,"P"))
- SET PSOST0=5
- +2 IF PSOST0
- DO FSTA
- +3 QUIT
- FSTA SET $PIECE(PSORX0,"^",15)=PSOST0
- +1 NEW DIE,DR,DA
- SET DIE=52
- SET DA=PSOBUILD("RX")
- SET DR="100////"_PSOST0
- DO ^DIE
- KILL DIE,DR,DA
- +2 QUIT
- +3 ;
- EOJ KILL ORD,PSOX,PSOEXPDT,PSODRG,PSODRUG0,PSOLC,PSONDF,PSOQFLG,PSORFRM,PSORX0,PSORX2,PSORX3,PSOST0,PSOSTF,PSOSTN,PSOJ,PSODRUGN,PSOVACL,PSOBUILD,PSODYS,PEN,DRG,NON,NVA
- +1 QUIT
- INPAT(PSODFN) ;entry point for inpat meds to view patient's outpat. meds
- +1 DO FULL^VALM1
- +2 SET INPAT=1
- SET X2=-120
- SET X1=DT
- DO C^%DTC
- SET PSODTCUT=X
- DO START
- DO ^PSODSPL
- +3 KILL PSOSD,DDH,PSCNT,PSOCT,PSODD,PSOOI,PSOPAR,PSOSTA,STP,STR,PSODTCUT,PSODFN,INPAT,DRG
- +4 QUIT
