- PSOORDRG ;BIR/SAB - order entry drug selection ;11/13/97
- ;;7.0;OUTPATIENT PHARMACY;**3,29,49,46,81,105,134,144,132,188,207,148,243,251,379**;DEC 1997;Build 28
- ;External references to ^PSJORUT2 supported by DBIA 2376
- ;External reference to ^PS(50.7 supported by DBIA 2223
- ;External reference to ^PS(50.605 supported by DBIA 696
- ;External reference to ^PSDRUG supported by DBIA 221
- ;External reference to ^PS(55 supported by DBIA 2228
- ;External reference to ^PS(56 supported by DBIA 2229
- ;External reference to ^PS(50.416 supported by DBIA 692
- ;External reference to DDIEX^PSNAPIS supported by DBIA 2574
- ;External references to ^ORRDI1 supported by DBIA 4659
- ;Reference to $$GETNDC^PSSNDCUT supported by IA 4707
- ;
- EN(PSODFN,DREN) ;
- K ^TMP($J,"DI"),^TMP($J,"DD"),^TMP($J,"DC"),^TMP($J,"DI"_PSODFN),PSOPHI S INDX=0
- ;build patient's drug profile outpat/inpat/non-va
- D BLD,ENCHK^PSJORUT2(PSODFN,.INDX),NVA
- ;collect drug info
- DRG ;S X=DREN,DIC="^PSDRUG(",DIC(0)="MQNZO" D ^DIC K DIC,PSOY Q:Y<1 S PSOY=Y,PSOY(0)=Y(0) K X,Y
- N PSOICT S PSOICT=""
- S PSOY=DREN_"^"_$P($G(^PSDRUG(DREN,0)),"^"),PSOY(0)=$G(^PSDRUG(DREN,0)) K X,Y
- S PSODRUG("IEN")=+PSOY,PSODRUG("VA CLASS")=$P(PSOY(0),"^",2),PSODRUG("NAME")=$P(PSOY(0),"^")
- S:+$G(^PSDRUG(+PSOY,2)) PSODRUG("OI")=+$G(^(2)),PSODRUG("OIN")=$P(^PS(50.7,+$G(^(2)),0),"^")
- S PSODRUG("NDF")=$S($G(^PSDRUG(+PSOY,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)
- S PSODRUG("MAXDOSE")=$P(PSOY(0),"^",4),PSODRUG("DEA")=$P(PSOY(0),"^",3),PSODRUG("CLN")=$S($D(^PSDRUG(+PSOY,"ND")):+$P(^("ND"),"^",6),1:0)
- S PSODRUG("SIG")=$P(PSOY(0),"^",5),PSODRUG("NDC")=$$GETNDC^PSSNDCUT(+PSOY,$G(PSOSITE))
- S PSODRUG("DAW")=$$GET1^DIQ(50,+PSOY,81)
- S PSOX1=$G(^PSDRUG(+PSOY,660)),PSODRUG("COST")=$P($G(PSOX1),"^",6),PSODRUG("UNIT")=$P($G(PSOX1),"^",8),PSODRUG("EXPIRATION DATE")=$P($G(PSOX1),"^",9)
- K PSOX1,PSOY Q:$G(POERR)
- ;dup drug/class check
- S DNM=0 F S DNM=$O(^TMP($J,"ORDERS",DNM)) Q:'DNM D
- .S DRNM=$P(^TMP($J,"ORDERS",DNM),"^",3)
- .I PSODRUG("NAME")=DRNM S DD=$G(DD)+1,^TMP($J,"DD",DD,0)=PSODRUG("IEN")_"^"_PSODRUG("NAME")_"^"_$P(^TMP($J,"ORDERS",DNM),"^",4)_"^"_$P(^(DNM),"^",5) Q:'$G(PSOPHI)
- .I PSODRUG("VA CLASS")]"",$E(PSODRUG("VA CLASS"),1,4)=$E($P(^TMP($J,"ORDERS",DNM),"^"),1,4),DRNM'=PSODRUG("NAME") D
- ..I $E(PSODRUG("VA CLASS"),1,2)="HA",$E($P(^TMP($J,"ORDERS",DNM),"^"),1,2)="HA" Q
- ..S PSODC=$O(^PS(50.605,"B",PSODRUG("VA CLASS"),0)) Q:'PSODC
- ..S DC=$G(DC)+1,^TMP($J,"DC",DC,0)=PSODRUG("VA CLASS")
- ..S PSODC=$P(^PS(50.605,PSODC,0),"^",2),^TMP($J,"DC",DC,0)=^TMP($J,"DC",DC,0)_"^"_PSODC_"^"_$O(^PSDRUG("B",DRNM,0))_"^"_DRNM_"^"_$P(^TMP($J,"ORDERS",DNM),"^",4)_"^"_$P(^(DNM),"^",5)
- ;drug interaction check
- S DRG=0
- F S DRG=$O(^TMP($J,"ORDERS",DRG)) Q:'DRG S NDF=$P(^TMP($J,"ORDERS",DRG),"^",2) D
- .S IT=0,PSOICT=""
- .F S IT=$O(^PS(56,"APD",NDF,PSODRUG("NDF"),IT)) Q:'IT D
- ..Q:$$DDIEX^PSNAPIS($P(NDF,"A"),$P(NDF,"A",2))
- ..Q:$$DDIEX^PSNAPIS($P(PSODRUG("NDF"),"A"),$P(PSODRUG("NDF"),"A",2))
- ..Q:$P(^PS(56,IT,0),"^",7)&($P(^PS(56,IT,0),"^",7)<DT)
- ..I 'PSOICT S PSOICT=IT Q
- ..I $P($G(^PS(56,IT,0)),"^",4)=1 S PSOICT=IT Q
- ..Q
- .I 'PSOICT Q
- .S IT=PSOICT
- .S DRNM=$P(^TMP($J,"ORDERS",DRG),"^",3),ORN=$P(^(DRG),"^",4),RXN=$P(^(DRG),"^",5)
- .S DI=$G(DI)+1,^TMP($J,"DI",DI,0)=$O(^PSDRUG("B",DRNM,0))_"^"_DRNM_"^"_IT_"^"_$S($P(^PS(56,IT,0),"^",4)=1:"CRITICAL",1:"SIGNIFICANT")_"^"
- .S ^TMP($J,"DI",DI,0)=^TMP($J,"DI",DI,0)_$P(^PS(50.416,$P(^PS(56,IT,0),"^",2),0),"^")_"^"_$P(^PS(50.416,$P(^PS(56,IT,0),"^",3),0),"^")_"^"_ORN_"^"_RXN
- D REMOTE
- Q:$G(PSOPHI)
- EXIT K ^TMP($J,"ORDERS"),DFN,DA,DNM,DUPRX0,RX,Y,ZZ,PSOCLOZ,PSOY,DRG,DNM,DD,DI,DC,IT,PSODRUG,PSOY,ORN,DRNM
- K PSOX,EXPDT,PSODRUG0,PSORX0,PSORX2,PSORX3,PSOST0,PSOVACL,X,Y,X1,X2,RXN
- Q
- BLD K ^TMP($J,"ORDERS") I '$D(PSODFN)!('$D(DT)) G EXIT
- S X1=DT,X2=-120 D C^%DTC S PSODTCUT=X D BUILD G GETX
- Q
- BUILD ;build profiles
- S EXPDT=PSODTCUT-1,RX=0
- F S EXPDT=$O(^PS(55,PSODFN,"P","A",EXPDT)) Q:'EXPDT F S RX=$O(^PS(55,PSODFN,"P","A",EXPDT,RX)) Q:'RX I $D(^PSRX(RX,0)) D GET
- S EN=0
- F PSOEN=0:0 S PSOEN=$O(^PS(52.41,"AOR",PSODFN,PSOEN)) Q:'PSOEN D
- .F S EN=$O(^PS(52.41,"AOR",PSODFN,PSOEN,EN)) Q:'EN D
- ..Q:'$P(^PS(52.41,EN,0),"^",8)
- ..S PSOOI=^PS(52.41,EN,0)
- ..I $P(PSOOI,"^",3)'="DC"&($P(PSOOI,"^",3)'="DE") D
- ...I '$P(^PS(52.41,EN,0),"^",9) D BLDOI Q
- ...S PSODD=+$P(PSOOI,"^",9) D SETTMP
- D BUILDX
- Q
- ;
- BLDOI ;If no DD/non-standard dose, get all drugs for OI
- N PSOI S PSOI=$P(PSOOI,"^",8) Q:'PSOOI
- S PSODD="" F S PSODD=$O(^PSDRUG("ASP",PSOI,PSODD)) Q:'PSODD D SETTMP
- Q
- ;
- SETTMP ;Create ^TMP($J,"ORDERS"
- Q:$P(PSOOI,"^",3)="RF"
- S DRG=$S(PSODD:$P($G(^PSDRUG(PSODD,0)),"^"),1:"") Q:DRG']""
- S INDX=$G(INDX)+1,^TMP($J,"ORDERS",INDX)=$S(PSODD:$P(^PSDRUG(PSODD,0),"^",2),1:"")_"^"_$S($G(^PSDRUG(PSODD,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)_"^"_DRG_"^"_$P(^PS(52.41,EN,0),"^")_"^"_EN_"P;O"
- Q
- ;
- BUILDX K EN,PSOOI,PSODD,PSOEN Q
- ;
- GET ;data for profiles
- S PSORX0=^PSRX(RX,0),PSOST0=+^("STA") Q:PSOST0>5&(PSOST0'=16)
- S PSORX2=$G(^PSRX(RX,2)),PSORX3=$G(^(3)),ORN=$P($G(^("OR1")),"^",2) S:PSORX3="" PSORX3=$P(PSORX2,"^",2)
- S PSODRUG=+$P(PSORX0,"^",6) Q:'$D(^PSDRUG(PSODRUG,0))
- S PSODRUG0=^PSDRUG(PSODRUG,0),PSOVACL=$P(PSODRUG0,"^",2)
- ;
- I EXPDT<DT D
- .N DIE,DIC,DR,DA S STAT="SC",DIE=52,DA=RX,DR="100////11" D ^DIE K DIE,DIC,DR,DA
- .D ECAN^PSOUTL(RX) S DA=RX
- .S COMM="Prescription Expired",PHARMST="ZE" D EN^PSOHLSN1(DA,STAT,PHARMST,COMM)
- S INDX=$G(INDX)+1
- S ^TMP($J,"ORDERS",INDX)=PSOVACL_"^"_$S($G(^PSDRUG(PSODRUG,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)_"^"_$P(^PSDRUG(PSODRUG,0),"^")_"^"_ORN_"^"_RX_"R;O"
- Q
- GETX ;
- K PSOX,EXPDT,PSODRUG,PSODRUG0,PSORX0,PSORX2,PSORX3,PSOST0,PSOVACL,X,Y,X1,X2,ORN
- Q
- CLOZ ;
- S ANQRTN=$P(^PSDRUG(PSODRUG("IEN"),"CLOZ1"),"^"),ANQX=0,P(5)=PSODRUG("IEN"),DFN=PSODFN,X=ANQRTN
- X ^%ZOSF("TEST") I D @("^"_ANQRTN) S:$G(ANQX) PSORX("DFLG")=1
- K P(5),ANQRTN,ANQX,X
- Q
- DRGCHK(PSODFN,DREN,DDRUG) ;Only check DREN against drug in DDRG()
- ;* PSODFN = Patient's DFN
- ;* DREN = Dispense drug to be checked against the drug in the array
- ;* DDRUG = The array of dispense drug in the buffer.
- ;*
- K ^TMP($J,"DI"),^TMP($J,"DD"),^TMP($J,"DC")
- NEW DDRUG0,DDRUGND,COD,PSJINX S COD="",PSJINX=0
- S DDRUG=0 F S DDRUG=$O(DDRUG(DDRUG)) Q:'DDRUG D DDRUG^PSJORUT2
- D DRG
- Q
- OIDRG(PSODFN,PSOI) ;checks every drug tied to orderable item passed by package use
- K ^TMP($J,"DI"),^TMP($J,"DD"),^TMP($J,"DC"),DD,DC,DI N DREN S INDX=0,PSOPHI=1
- ;build patient's drug profile inpat/outpat/non-va
- D BLD,ENCHK^PSJORUT2(PSODFN,.INDX),NVA
- F DREN=0:0 S DREN=$O(^PSDRUG("ASP",PSOI,DREN)) Q:'DREN I $D(^PSDRUG(DREN,O)) D DRG
- K PSOPHI D EXIT
- Q
- NVA ;checks existing nva
- F I=0:0 S I=$O(^PS(55,PSODFN,"NVA",I)) Q:'I D:$D(^PS(55,PSODFN,"NVA",I,0))
- .Q:$P(^PS(55,PSODFN,"NVA",I,0),"^",7)
- .S PSOI=$P(^PS(55,PSODFN,"NVA",I,0),"^"),DRG=$P(^(0),"^",2),ORN=$P(^(0),"^",8)
- .I DRG,$G(^PSDRUG(DRG,0))]"" D NVA1 K DRG Q
- .K DRG F DRG=0:0 S DRG=$O(^PSDRUG("ASP",PSOI,DRG)) Q:'DRG D:$D(^PSDRUG(DRG,0)) NVA1
- K I,PSOOTC,ORN,PSOI,DRG,DRGN,PSOY,VACL,NDF
- Q
- NVA1 S PSOY=$G(^PSDRUG(DRG,0)),DRGN=$P(PSOY,"^"),VACL=$P(PSOY,"^",2)
- S NDF=$S($G(^PSDRUG(DRG,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)
- S INDX=$G(INDX)+1,^TMP($J,"ORDERS",INDX)=VACL_"^"_NDF_"^"_DRGN_"^"_ORN_"^"_I_"N;O"
- Q
- ;
- REMOTE ;
- I $T(HAVEHDR^ORRDI1)']"" Q
- I '$$HAVEHDR^ORRDI1 Q
- D REMOTE^PSOORRDI(PSODFN,DREN)
- K ^TMP($J,"DI"_PSODFN) ;THIS LEVEL ONLY NEEDED FOR BACKDOOR OUTPATIENT PHARMACY CHECKS
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOORDRG 7547 printed Feb 18, 2025@23:58:15 Page 2
- PSOORDRG ;BIR/SAB - order entry drug selection ;11/13/97
- +1 ;;7.0;OUTPATIENT PHARMACY;**3,29,49,46,81,105,134,144,132,188,207,148,243,251,379**;DEC 1997;Build 28
- +2 ;External references to ^PSJORUT2 supported by DBIA 2376
- +3 ;External reference to ^PS(50.7 supported by DBIA 2223
- +4 ;External reference to ^PS(50.605 supported by DBIA 696
- +5 ;External reference to ^PSDRUG supported by DBIA 221
- +6 ;External reference to ^PS(55 supported by DBIA 2228
- +7 ;External reference to ^PS(56 supported by DBIA 2229
- +8 ;External reference to ^PS(50.416 supported by DBIA 692
- +9 ;External reference to DDIEX^PSNAPIS supported by DBIA 2574
- +10 ;External references to ^ORRDI1 supported by DBIA 4659
- +11 ;Reference to $$GETNDC^PSSNDCUT supported by IA 4707
- +12 ;
- EN(PSODFN,DREN) ;
- +1 KILL ^TMP($JOB,"DI"),^TMP($JOB,"DD"),^TMP($JOB,"DC"),^TMP($JOB,"DI"_PSODFN),PSOPHI
- SET INDX=0
- +2 ;build patient's drug profile outpat/inpat/non-va
- +3 DO BLD
- DO ENCHK^PSJORUT2(PSODFN,.INDX)
- DO NVA
- +4 ;collect drug info
- DRG ;S X=DREN,DIC="^PSDRUG(",DIC(0)="MQNZO" D ^DIC K DIC,PSOY Q:Y<1 S PSOY=Y,PSOY(0)=Y(0) K X,Y
- +1 NEW PSOICT
- SET PSOICT=""
- +2 SET PSOY=DREN_"^"_$PIECE($GET(^PSDRUG(DREN,0)),"^")
- SET PSOY(0)=$GET(^PSDRUG(DREN,0))
- KILL X,Y
- +3 SET PSODRUG("IEN")=+PSOY
- SET PSODRUG("VA CLASS")=$PIECE(PSOY(0),"^",2)
- SET PSODRUG("NAME")=$PIECE(PSOY(0),"^")
- +4 if +$GET(^PSDRUG(+PSOY,2))
- SET PSODRUG("OI")=+$GET(^(2))
- SET PSODRUG("OIN")=$PIECE(^PS(50.7,+$GET(^(2)),0),"^")
- +5 SET PSODRUG("NDF")=$SELECT($GET(^PSDRUG(+PSOY,"ND"))]"":+^("ND")_"A"_$PIECE(^("ND"),"^",3),1:0)
- +6 SET PSODRUG("MAXDOSE")=$PIECE(PSOY(0),"^",4)
- SET PSODRUG("DEA")=$PIECE(PSOY(0),"^",3)
- SET PSODRUG("CLN")=$SELECT($DATA(^PSDRUG(+PSOY,"ND")):+$PIECE(^("ND"),"^",6),1:0)
- +7 SET PSODRUG("SIG")=$PIECE(PSOY(0),"^",5)
- SET PSODRUG("NDC")=$$GETNDC^PSSNDCUT(+PSOY,$GET(PSOSITE))
- +8 SET PSODRUG("DAW")=$$GET1^DIQ(50,+PSOY,81)
- +9 SET PSOX1=$GET(^PSDRUG(+PSOY,660))
- SET PSODRUG("COST")=$PIECE($GET(PSOX1),"^",6)
- SET PSODRUG("UNIT")=$PIECE($GET(PSOX1),"^",8)
- SET PSODRUG("EXPIRATION DATE")=$PIECE($GET(PSOX1),"^",9)
- +10 KILL PSOX1,PSOY
- if $GET(POERR)
- QUIT
- +11 ;dup drug/class check
- +12 SET DNM=0
- FOR
- SET DNM=$ORDER(^TMP($JOB,"ORDERS",DNM))
- if 'DNM
- QUIT
- Begin DoDot:1
- +13 SET DRNM=$PIECE(^TMP($JOB,"ORDERS",DNM),"^",3)
- +14 IF PSODRUG("NAME")=DRNM
- SET DD=$GET(DD)+1
- SET ^TMP($JOB,"DD",DD,0)=PSODRUG("IEN")_"^"_PSODRUG("NAME")_"^"_$PIECE(^TMP($JOB,"ORDERS",DNM),"^",4)_"^"_$PIECE(^(DNM),"^",5)
- if '$GET(PSOPHI)
- QUIT
- +15 IF PSODRUG("VA CLASS")]""
- IF $EXTRACT(PSODRUG("VA CLASS"),1,4)=$EXTRACT($PIECE(^TMP($JOB,"ORDERS",DNM),"^"),1,4)
- IF DRNM'=PSODRUG("NAME")
- Begin DoDot:2
- +16 IF $EXTRACT(PSODRUG("VA CLASS"),1,2)="HA"
- IF $EXTRACT($PIECE(^TMP($JOB,"ORDERS",DNM),"^"),1,2)="HA"
- QUIT
- +17 SET PSODC=$ORDER(^PS(50.605,"B",PSODRUG("VA CLASS"),0))
- if 'PSODC
- QUIT
- +18 SET DC=$GET(DC)+1
- SET ^TMP($JOB,"DC",DC,0)=PSODRUG("VA CLASS")
- +19 SET PSODC=$PIECE(^PS(50.605,PSODC,0),"^",2)
- SET ^TMP($JOB,"DC",DC,0)=^TMP($JOB,"DC",DC,0)_"^"_PSODC_"^"_$ORDER(^PSDRUG("B",DRNM,0))_"^"_DRNM_"^"_$PIECE(^TMP($JOB,"ORDERS",DNM),"^",4)_"^"_$PIECE(^(DNM),"^",5)
- End DoDot:2
- End DoDot:1
- +20 ;drug interaction check
- +21 SET DRG=0
- +22 FOR
- SET DRG=$ORDER(^TMP($JOB,"ORDERS",DRG))
- if 'DRG
- QUIT
- SET NDF=$PIECE(^TMP($JOB,"ORDERS",DRG),"^",2)
- Begin DoDot:1
- +23 SET IT=0
- SET PSOICT=""
- +24 FOR
- SET IT=$ORDER(^PS(56,"APD",NDF,PSODRUG("NDF"),IT))
- if 'IT
- QUIT
- Begin DoDot:2
- +25 if $$DDIEX^PSNAPIS($PIECE(NDF,"A"),$PIECE(NDF,"A",2))
- QUIT
- +26 if $$DDIEX^PSNAPIS($PIECE(PSODRUG("NDF"),"A"),$PIECE(PSODRUG("NDF"),"A",2))
- QUIT
- +27 if $PIECE(^PS(56,IT,0),"^",7)&($PIECE(^PS(56,IT,0),"^",7)<DT)
- QUIT
- +28 IF 'PSOICT
- SET PSOICT=IT
- QUIT
- +29 IF $PIECE($GET(^PS(56,IT,0)),"^",4)=1
- SET PSOICT=IT
- QUIT
- +30 QUIT
- End DoDot:2
- +31 IF 'PSOICT
- QUIT
- +32 SET IT=PSOICT
- +33 SET DRNM=$PIECE(^TMP($JOB,"ORDERS",DRG),"^",3)
- SET ORN=$PIECE(^(DRG),"^",4)
- SET RXN=$PIECE(^(DRG),"^",5)
- +34 SET DI=$GET(DI)+1
- SET ^TMP($JOB,"DI",DI,0)=$ORDER(^PSDRUG("B",DRNM,0))_"^"_DRNM_"^"_IT_"^"_$SELECT($PIECE(^PS(56,IT,0),"^",4)=1:"CRITICAL",1:"SIGNIFICANT")_"^"
- +35 SET ^TMP($JOB,"DI",DI,0)=^TMP($JOB,"DI",DI,0)_$PIECE(^PS(50.416,$PIECE(^PS(56,IT,0),"^",2),0),"^")_"^"_$PIECE(^PS(50.416,$PIECE(^PS(56,IT,0),"^",3),0),"^")_"^"_ORN_"^"_RXN
- End DoDot:1
- +36 DO REMOTE
- +37 if $GET(PSOPHI)
- QUIT
- EXIT KILL ^TMP($JOB,"ORDERS"),DFN,DA,DNM,DUPRX0,RX,Y,ZZ,PSOCLOZ,PSOY,DRG,DNM,DD,DI,DC,IT,PSODRUG,PSOY,ORN,DRNM
- +1 KILL PSOX,EXPDT,PSODRUG0,PSORX0,PSORX2,PSORX3,PSOST0,PSOVACL,X,Y,X1,X2,RXN
- +2 QUIT
- BLD KILL ^TMP($JOB,"ORDERS")
- IF '$DATA(PSODFN)!('$DATA(DT))
- GOTO EXIT
- +1 SET X1=DT
- SET X2=-120
- DO C^%DTC
- SET PSODTCUT=X
- DO BUILD
- GOTO GETX
- +2 QUIT
- BUILD ;build profiles
- +1 SET EXPDT=PSODTCUT-1
- SET RX=0
- +2 FOR
- SET EXPDT=$ORDER(^PS(55,PSODFN,"P","A",EXPDT))
- if 'EXPDT
- QUIT
- FOR
- SET RX=$ORDER(^PS(55,PSODFN,"P","A",EXPDT,RX))
- if 'RX
- QUIT
- IF $DATA(^PSRX(RX,0))
- DO GET
- +3 SET EN=0
- +4 FOR PSOEN=0:0
- SET PSOEN=$ORDER(^PS(52.41,"AOR",PSODFN,PSOEN))
- if 'PSOEN
- QUIT
- Begin DoDot:1
- +5 FOR
- SET EN=$ORDER(^PS(52.41,"AOR",PSODFN,PSOEN,EN))
- if 'EN
- QUIT
- Begin DoDot:2
- +6 if '$PIECE(^PS(52.41,EN,0),"^",8)
- QUIT
- +7 SET PSOOI=^PS(52.41,EN,0)
- +8 IF $PIECE(PSOOI,"^",3)'="DC"&($PIECE(PSOOI,"^",3)'="DE")
- Begin DoDot:3
- +9 IF '$PIECE(^PS(52.41,EN,0),"^",9)
- DO BLDOI
- QUIT
- +10 SET PSODD=+$PIECE(PSOOI,"^",9)
- DO SETTMP
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +11 DO BUILDX
- +12 QUIT
- +13 ;
- BLDOI ;If no DD/non-standard dose, get all drugs for OI
- +1 NEW PSOI
- SET PSOI=$PIECE(PSOOI,"^",8)
- if 'PSOOI
- QUIT
- +2 SET PSODD=""
- FOR
- SET PSODD=$ORDER(^PSDRUG("ASP",PSOI,PSODD))
- if 'PSODD
- QUIT
- DO SETTMP
- +3 QUIT
- +4 ;
- SETTMP ;Create ^TMP($J,"ORDERS"
- +1 if $PIECE(PSOOI,"^",3)="RF"
- QUIT
- +2 SET DRG=$SELECT(PSODD:$PIECE($GET(^PSDRUG(PSODD,0)),"^"),1:"")
- if DRG']""
- QUIT
- +3 SET INDX=$GET(INDX)+1
- SET ^TMP($JOB,"ORDERS",INDX)=$SELECT(PSODD:$PIECE(^PSDRUG(PSODD,0),"^",2),1:"")_"^"_$SELECT($GET(^PSDRUG(PSODD,"ND"))]"":+^("ND")_"A"_$PIECE(^("ND"),"^",3),1:0)_"^"_DRG_"^"_$PIECE(^PS(52.41,EN,0),"^")_"^"_EN_"P;O"
- +4 QUIT
- +5 ;
- BUILDX KILL EN,PSOOI,PSODD,PSOEN
- QUIT
- +1 ;
- GET ;data for profiles
- +1 SET PSORX0=^PSRX(RX,0)
- SET PSOST0=+^("STA")
- if PSOST0>5&(PSOST0'=16)
- QUIT
- +2 SET PSORX2=$GET(^PSRX(RX,2))
- SET PSORX3=$GET(^(3))
- SET ORN=$PIECE($GET(^("OR1")),"^",2)
- if PSORX3=""
- SET PSORX3=$PIECE(PSORX2,"^",2)
- +3 SET PSODRUG=+$PIECE(PSORX0,"^",6)
- if '$DATA(^PSDRUG(PSODRUG,0))
- QUIT
- +4 SET PSODRUG0=^PSDRUG(PSODRUG,0)
- SET PSOVACL=$PIECE(PSODRUG0,"^",2)
- +5 ;
- +6 IF EXPDT<DT
- Begin DoDot:1
- +7 NEW DIE,DIC,DR,DA
- SET STAT="SC"
- SET DIE=52
- SET DA=RX
- SET DR="100////11"
- DO ^DIE
- KILL DIE,DIC,DR,DA
- +8 DO ECAN^PSOUTL(RX)
- SET DA=RX
- +9 SET COMM="Prescription Expired"
- SET PHARMST="ZE"
- DO EN^PSOHLSN1(DA,STAT,PHARMST,COMM)
- End DoDot:1
- +10 SET INDX=$GET(INDX)+1
- +11 SET ^TMP($JOB,"ORDERS",INDX)=PSOVACL_"^"_$SELECT($GET(^PSDRUG(PSODRUG,"ND"))]"":+^("ND")_"A"_$PIECE(^("ND"),"^",3),1:0)_"^"_$PIECE(^PSDRUG(PSODRUG,0),"^")_"^"_ORN_"^"_RX_"R;O"
- +12 QUIT
- GETX ;
- +1 KILL PSOX,EXPDT,PSODRUG,PSODRUG0,PSORX0,PSORX2,PSORX3,PSOST0,PSOVACL,X,Y,X1,X2,ORN
- +2 QUIT
- CLOZ ;
- +1 SET ANQRTN=$PIECE(^PSDRUG(PSODRUG("IEN"),"CLOZ1"),"^")
- SET ANQX=0
- SET P(5)=PSODRUG("IEN")
- SET DFN=PSODFN
- SET X=ANQRTN
- +2 XECUTE ^%ZOSF("TEST")
- IF $TEST
- DO @("^"_ANQRTN)
- if $GET(ANQX)
- SET PSORX("DFLG")=1
- +3 KILL P(5),ANQRTN,ANQX,X
- +4 QUIT
- DRGCHK(PSODFN,DREN,DDRUG) ;Only check DREN against drug in DDRG()
- +1 ;* PSODFN = Patient's DFN
- +2 ;* DREN = Dispense drug to be checked against the drug in the array
- +3 ;* DDRUG = The array of dispense drug in the buffer.
- +4 ;*
- +5 KILL ^TMP($JOB,"DI"),^TMP($JOB,"DD"),^TMP($JOB,"DC")
- +6 NEW DDRUG0,DDRUGND,COD,PSJINX
- SET COD=""
- SET PSJINX=0
- +7 SET DDRUG=0
- FOR
- SET DDRUG=$ORDER(DDRUG(DDRUG))
- if 'DDRUG
- QUIT
- DO DDRUG^PSJORUT2
- +8 DO DRG
- +9 QUIT
- OIDRG(PSODFN,PSOI) ;checks every drug tied to orderable item passed by package use
- +1 KILL ^TMP($JOB,"DI"),^TMP($JOB,"DD"),^TMP($JOB,"DC"),DD,DC,DI
- NEW DREN
- SET INDX=0
- SET PSOPHI=1
- +2 ;build patient's drug profile inpat/outpat/non-va
- +3 DO BLD
- DO ENCHK^PSJORUT2(PSODFN,.INDX)
- DO NVA
- +4 FOR DREN=0:0
- SET DREN=$ORDER(^PSDRUG("ASP",PSOI,DREN))
- if 'DREN
- QUIT
- IF $DATA(^PSDRUG(DREN,O))
- DO DRG
- +5 KILL PSOPHI
- DO EXIT
- +6 QUIT
- NVA ;checks existing nva
- +1 FOR I=0:0
- SET I=$ORDER(^PS(55,PSODFN,"NVA",I))
- if 'I
- QUIT
- if $DATA(^PS(55,PSODFN,"NVA",I,0))
- Begin DoDot:1
- +2 if $PIECE(^PS(55,PSODFN,"NVA",I,0),"^",7)
- QUIT
- +3 SET PSOI=$PIECE(^PS(55,PSODFN,"NVA",I,0),"^")
- SET DRG=$PIECE(^(0),"^",2)
- SET ORN=$PIECE(^(0),"^",8)
- +4 IF DRG
- IF $GET(^PSDRUG(DRG,0))]""
- DO NVA1
- KILL DRG
- QUIT
- +5 KILL DRG
- FOR DRG=0:0
- SET DRG=$ORDER(^PSDRUG("ASP",PSOI,DRG))
- if 'DRG
- QUIT
- if $DATA(^PSDRUG(DRG,0))
- DO NVA1
- End DoDot:1
- +6 KILL I,PSOOTC,ORN,PSOI,DRG,DRGN,PSOY,VACL,NDF
- +7 QUIT
- NVA1 SET PSOY=$GET(^PSDRUG(DRG,0))
- SET DRGN=$PIECE(PSOY,"^")
- SET VACL=$PIECE(PSOY,"^",2)
- +1 SET NDF=$SELECT($GET(^PSDRUG(DRG,"ND"))]"":+^("ND")_"A"_$PIECE(^("ND"),"^",3),1:0)
- +2 SET INDX=$GET(INDX)+1
- SET ^TMP($JOB,"ORDERS",INDX)=VACL_"^"_NDF_"^"_DRGN_"^"_ORN_"^"_I_"N;O"
- +3 QUIT
- +4 ;
- REMOTE ;
- +1 IF $TEXT(HAVEHDR^ORRDI1)']""
- QUIT
- +2 IF '$$HAVEHDR^ORRDI1
- QUIT
- +3 DO REMOTE^PSOORRDI(PSODFN,DREN)
- +4 ;THIS LEVEL ONLY NEEDED FOR BACKDOOR OUTPATIENT PHARMACY CHECKS
- KILL ^TMP($JOB,"DI"_PSODFN)
- +5 QUIT
- +6 ;