Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSGSICH1

PSGSICH1.m

Go to the documentation of this file.
PSGSICH1 ;BIR/JCH-PROVIDER & PHARMACY OVERRIDE UTILITIES 1; 01/25/11 1:02pm
 ;;5.0;INPATIENT MEDICATIONS;**254,281**;16 DEC 97;Build 113
 ;
 ; Reference to OCAPI^ORCHECK is supported by DBIA #4859.
 ; Reference to OCCNT^ORACPI1 is supported by DBIA #5637
 ; Reference to ^APSPQA(32.4 is supported by DBIA #2179
 ;
GETPROVL(PSGP,PSGORD,OUTARRAY) ; Get LAST (most recent) Provider Override associated with Inpatient Order
 K OUTARRAY,PSJOCHIS,PSJQUITD,PSJHISTF,PSJOVRAR
 N PSJDSPLN,ILCNT,PSJOVRAR,PSJCUROV,PSJCURIN,PSJTMPX,PSJTMPI,PSJINTAR,PSJINTER,PSJOVDON,PSJDONED,PSJINDEN,PSJBANNR,PSJHISTF,PSJHISTO,PSJIOSL,X,Y,DR,DIR,DIE,DIC,PSJOROIC
 Q:'$G(PSGP)!'$G(PSGORD)
 D GETOORDS^PSGSICH2(PSGP,PSGORD,.PSJOVRAR)
 S PSJOROIC=$$OROICHK^PSGSICH(PSGP,PSGORD,.PSJOVRAR)
 S PSJTMPX="" F  S PSJTMPX=$O(PSJOVRAR(PSGP,PSGORD,PSJTMPX),-1) Q:'PSJTMPX!$G(PSJOVDON)  D
 .S PSJCUROV="" F  S PSJCUROV=$O(PSJOVRAR(PSGP,PSGORD,PSJTMPX,PSJCUROV),-1) Q:'PSJCUROV!$G(PSJOVDON)  D
 ..I PSJCUROV["C",(PSJCUROV'>PSJOROIC) S PSJOVDON=1 Q
 ..Q:(PSJCUROV)'["C"  Q:'$$OCCNT^OROCAPI1(+PSJCUROV)
 ..N PSJTMPOO S PSJTMPOO=$G(PSJOVRAR(PSGP,PSGORD,PSJTMPX,PSJCUROV))
 ..D GETPROVR(PSGP,PSJTMPOO,.OUTARRAY,+PSJCUROV)
 ..I $D(OUTARRAY)>1 S PSJOVDON=1
 K ^TMP($J,"PSJ")
 Q
 ;
GETPROVR(PSGP,PSGORD,OUTARRAY,PSJCPRS) ; Get Provider Override
 ; Input: PSGP - Patient DFN (IEN from Pharmacy Patient (#55) file.
 ;        PSGORD - Inpatient Order number from Pharmacy Patient (#55) file or NON-VERIFIED ORDERS (#53.1) file
 ;        OUTARRAY - Name of array in which override data will be returned
 ;        PSJCPRS - CPRS Order (#100) file IEN from which to retrieve Provider Override
 Q:$G(PSJNEWOE)
 N PSJ,DELIM,TXT,TXT1,TXT2,CAT K OUTARRAY,^TMP($J,"PSJ") S OUTARRAY=""
 S PSJCPRS=$S($G(PSJCPRS):PSJCPRS,PSGORD["U":$P($G(^PS(55,PSGP,5,+PSGORD,0)),U,21),PSGORD["V":$P($G(^PS(55,PSGP,"IV",+PSGORD,0)),U,21),PSGORD["P":$P($G(^PS(53.1,+PSGORD,0)),U,21),1:0)
 Q:'$G(PSJCPRS)
 D OCAPI^ORCHECK(+PSJCPRS,"PSJ"):$G(PSJCPRS)
 I PSJCPRS,$G(^TMP($J,"PSJ",1,"OC TEXT",1,0))'="" D
 .S PSJ=0 F  S PSJ=$O(^TMP($J,"PSJ",PSJ)) Q:'PSJ  D
 ..S TXT=$G(^TMP($J,"PSJ",PSJ,"OC TEXT",1,0))
 ..S CAT=3 S:TXT["CRITICAL drug-drug" CAT=2
 ..S:(TXT["Previous ")&(TXT[" adverse reaction") CAT=1 ;;cmf/281 change
 ..;;S:TXT["Previous adverse reaction" CAT=1 ;;cmf/281 removal
 ..I TXT]"" S OUTARRAY("PROVR",PSGP,+PSGORD,CAT,PSJ,0)=TXT
 .S PSJ=$O(^TMP($J,"PSJ",0))
 .D NAME^PSGSICH($G(^TMP($J,"PSJ",PSJ,"OR PROVIDER")),.X)
 .I X'="" S (TMPOAR,OUTARRAY("PROV",PSGP,+PSGORD,1))="Override Entered By: "_X D
 ..N PSJTITLE S PSJTITLE=$P($G(^VA(200,+^TMP($J,"PSJ",PSJ,"OR PROVIDER"),0)),"^",9) I PSJTITLE D
 ...N DIC,X,Y S DIC="^DIC(3.1,",DIC(0)="NZ" S X="`"_+PSJTITLE D ^DIC I Y S TMPOAR=TMPOAR_" ("_$P(Y,"^",2)_")"
 ..S OUTARRAY("PROV",PSGP,+PSGORD,1)=TMPOAR
 ..S X=$G(^TMP($J,"PSJ",PSJ,"OR DT")) I X D
 ...N PSJIDTMP S PSJIDTMP=$P($TR($$FMTE^XLFDT(X,2),"@","  "),":",1,2) S $P(PSJIDTMP,"/")=$S($L($P(PSJIDTMP,"/"))=1:0,1:"")_+$P(PSJIDTMP,"/") S $P(PSJIDTMP,"/",2)=$S($L($P(PSJIDTMP,"/",2))=1:0,1:"")_+$P(PSJIDTMP,"/",2)
 ...S OUTARRAY("PROV",PSGP,+PSGORD,2)="  Date/Time Entered: "_PSJIDTMP
 ..S OUTARRAY("PROV",PSGP,+PSGORD,3)="    Override Reason: "_$G(^TMP($J,"PSJ",PSJ,"OR REASON"))
 ..N TMPRV,TMPRVNAM S TMPRV=$S(PSGORD["U":$P($G(^PS(55,+PSGP,5,+PSGORD,0)),"^",2),PSGORD["P":$P($G(^PS(53.1,+PSGORD,0)),"^",2),PSGORD["V":$P($G(^PS(55,PSGP,"IV",+PSGORD,0)),"^",6),1:"") D
 ...S TMPRVNAM="" D NAME^PSGSICH(TMPRV,.TMPRVNAM) Q:TMPRVNAM=""
 ...S PSJTITLE=$P($G(^VA(200,+TMPRV,0)),"^",9) I PSJTITLE N DIC,X,Y S DIC="^DIC(3.1,",DIC(0)="NZ" S X="`"_+PSJTITLE D ^DIC I Y S PSJTITLE=$P(Y,"^",2)
 ...I PSJTITLE]"" S TMPRVNAM=TMPRVNAM_" ("_PSJTITLE_")"
 ..S OUTARRAY("PROV",PSGP,+PSGORD,0)="Overriding Provider: "_$G(TMPRVNAM)
 I $G(OUTARRAY("PROV",PSGP,+PSGORD,0))=""!('$D(OUTARRAY("PROVR",PSGP,+PSGORD,1))&'$D(OUTARRAY("PROVR",PSGP,+PSGORD,2))) K OUTARRAY S OUTARRAY=""
 K ^TMP($J,"PSJ")
 Q
 ;
DSPROVR(PSGP,PSGORD,OUTARRAY) ; Display Provider Overrides
 ; INPUT: PSGP - Patient DFN
 ;        PSGORD - Inpatient Order
 ;        OUTARRAY - Array containing Provider Overrides
 Q:$G(PSJNEWOE)!$G(PSJQUITD)
 Q:$D(OUTARRAY)<10
 N PSJDSPLN,TXT2,OCCNT,PSJL,PSJNXT,PSJINDEN,PSJBANNR,PSJIOSL,II,I2,JJ,OC,PSJM
 S PSJIOSL=$S($G(IOSL):IOSL,1:24)
 S PSJBANNR="Provider Overrides for this order" S PSJBANNR=$S($G(PSJOCHIS):"Historical ",1:"Current ")_PSJBANNR
 S $P(PSJDSPLN,"=",76)="=",PSJINDEN=8
 W !!,PSJDSPLN,!?PSJINDEN,"** ",PSJBANNR," **",!,PSJDSPLN,! S OCCNT=6
 F II=0:1:3 W !,$G(OUTARRAY("PROV",PSGP,+PSGORD,II)) S OCCNT=$G(OCCNT)+1
 W ! S CAT=0 F  S CAT=$O(OUTARRAY("PROVR",PSGP,+PSGORD,CAT)) Q:'CAT  D
 .I $G(OCCNT)<4 W !!,PSJDSPLN,!?PSJINDEN,"** ",PSJBANNR," **",!,PSJDSPLN,! S OCCNT=5
 .S OC=0 F  S OC=$O(OUTARRAY("PROVR",PSGP,+PSGORD,CAT,OC)) Q:'OC!$G(PSJQUITD)  D
 ..I $G(OCCNT)<4 W !!,PSJDSPLN,!?PSJINDEN,"** ",PSJBANNR," **",!,PSJDSPLN,! S OCCNT=5
 ..S PSJL=OUTARRAY("PROVR",PSGP,+PSGORD,CAT,OC,0) I $L(PSJL)>77 D
 ...F II=1:1 D  S PSJL=PSJM Q:PSJL=""
 ....S PSJM=$E(PSJL,79,999),PSJL=$E(PSJL,1,78) I PSJM="",PSJL]"" S OUTARRAY("PROVR",PSGP,+PSGORD,CAT,OC,0,II)=PSJL Q
 ....S PSJDONED=0 F I2=$L(PSJL):-1:1 Q:$G(PSJDONED)  I $E(PSJL,I2)=" " S PSJM=$E(PSJL,I2+1,$L(PSJL))_PSJM,PSJL=$E(PSJL,1,I2) S OUTARRAY("PROVR",PSGP,+PSGORD,CAT,OC,0,II)=PSJL,PSJDONED=1
 ...S PSJNXT=0 F  S PSJNXT=$O(OUTARRAY("PROVR",PSGP,+PSGORD,CAT,OC,0,PSJNXT)) Q:'PSJNXT!$G(PSJQUITD)  W !?2,OUTARRAY("PROVR",PSGP,+PSGORD,CAT,OC,0,PSJNXT) S OCCNT=$G(OCCNT)+1
 ...W ! S OCCNT=$G(OCCNT)+1
 ..Q:$G(PSJQUITD)
 ..I $L(OUTARRAY("PROVR",PSGP,+PSGORD,CAT,OC,0))<78 W !?2,OUTARRAY("PROVR",PSGP,+PSGORD,CAT,OC,0),! S OCCNT=$G(OCCNT)+2
 ..I OCCNT>($G(PSJIOSL)-6) D
 ...S JJ=($G(PSJIOSL)-2)-OCCNT F II=1:1:JJ W !
 ...D HLD^PSGSICH S OCCNT=0
 Q:$G(PSJQUITD)
 I OCCNT>4 D
 .I OCCNT<($G(PSJIOSL)) S JJ=($G(PSJIOSL)-2)-OCCNT F II=1:1:JJ W !
 .D HLD^PSGSICH S OCCNT=0
 K ^TMP($J,"PSJ")
 Q
 ;
INTRDIC(PSGP,PSGORD,OUTARRAY,PSJCURIN) ; Retrieve Intervention IEN's for a specific order and store in array
 ; Input: PSGP       - Patient IEN from PATIENT (#2b) file. (required).
 ;        PSGORD  - Inpatient Order from NON-VERIFIED ORDERS (#53.1) file or UD (#62) multiple or IV (#100) multiple of 
 ;                    PHARMACY PATIENT (#55) file.(required)
 ;        OUTARRAY  - Array name, passed by reference, to hold return values.(required)
 ;        PSJCURIN -  Current intervention flag.
 ;                    PSJCURIN = 0 - Return all interventions associated with order PSGORD regardless of date/time.
 ;                    PSJCURIN = 1 - Only return interventions, associated with order PSGORD, logged on the most recent Intervention date/time.
 ;                    PSJCURIN = 2 - Only return interventions, associated with order PJORDER, logged on most recent date, if at least one CRITICAL DRUG-DRUG or ALLERGY ADR was logged on the most recent Intervention date/time.
 ;
 N %,II,INT,FLDI,FLDE,WPLINE,INTERVEN,PSJIDTM,PSJCNDT,PSJINT,PSJCRAL,DA,D0,DIC,DR,DFN,PSJORDER K ^UTILITY("DIQ1",$J) K OUTARRAY S PSJINT="A",DFN=PSGP,PSJORDER=PSGORD
 I $G(PSJCURIN)=2 Q:'$$INTCHKO(DFN,PSJORDER)
 I PSJORDER["P" F II=1:1  S PSJINT=$O(^PS(53.1,+PSJORDER,11,PSJINT),-1) Q:'PSJINT  S INTERVEN=$G(^PS(53.1,+PSJORDER,11,PSJINT,0)),PSJIDTM=$P(INTERVEN,"^",2) D
 .S:(II=1) PSJCNDT=$P(INTERVEN,"^",2) I $G(PSJCURIN)>0 Q:(PSJCNDT'=PSJIDTM)
 .D ONEINTER^PSGSICH(INTERVEN,PSJORDER,PSJIDTM,.OUTARRAY)
 I PSJORDER["U" F II=1:1  S PSJINT=$O(^PS(55,DFN,5,+PSJORDER,10,PSJINT),-1) Q:'PSJINT  S INTERVEN=$G(^PS(55,DFN,5,+PSJORDER,10,PSJINT,0)),PSJIDTM=$P(INTERVEN,"^",2) D
 .S:(II=1) PSJCNDT=$P(INTERVEN,"^",2) I $G(PSJCURIN)>0 Q:(PSJCNDT'=PSJIDTM)
 .D ONEINTER^PSGSICH(INTERVEN,PSJORDER,PSJIDTM,.OUTARRAY)
 I PSJORDER["V" F II=1:1  S PSJINT=$O(^PS(55,DFN,"IV",+PSJORDER,8,PSJINT),-1) Q:'PSJINT  S INTERVEN=$G(^PS(55,DFN,"IV",+PSJORDER,8,PSJINT,0)),PSJIDTM=$P(INTERVEN,"^",2) D
 .S:(II=1) PSJCNDT=$P(INTERVEN,"^",2) I $G(PSJCURIN)>0 Q:(PSJCNDT'=PSJIDTM)
 .D ONEINTER^PSGSICH(INTERVEN,PSJORDER,PSJIDTM,.OUTARRAY)
 K PSJCURIN
 Q
 ;
OVRCHK(PSGP,PSGORD) ; If any Provider Overrides or Pharmacy Interventions exist for order, return 1, otherwise return 0.
 ; INPUT: PATIENT - Patient DFN
 ;          ORDER - Inpatient order
 Q:$D(^TMP("PSJINTER",$J)) 1
 Q:'$G(PSGORD) 0
 N TMPOC,TMPOCI,TMPFLG,FOUND,TMPOUTAR
 I '$G(DFN) N DFN S DFN=PSGP
 I $$INTCHKO(PSGP,PSGORD) Q 1
 K TMPOUTAR D GETPROVL(PSGP,PSGORD,.TMPOUTAR)
 I $O(TMPOUTAR("PROV","")) K TMPOUTAR Q 1
 Q:$G(FOUND) 1
 Q 0
 ;
INTCHKO(PSGP,PSGORD) ; If CRITICAL DRUG or ALLERGY Intervention exists for Inpatient order, return 1, otherwise return 0.
 ; INPUT: PATIENT - Patient DFN
 ;          PSGORD - Inpatient order
 N FOUND,PSJCRAL,II,PATIENT S FOUND=0
 I PSGORD["P" S II=0 F  S II=$O(^PS(53.1,+PSGORD,11,II)) Q:'II!FOUND  D
 .S INTERVEN=$G(^PS(53.1,+PSGORD,11,II,0)) S FOUND=$$INTCHK(+INTERVEN)
 I PSGORD["U" S II=0 F  S II=$O(^PS(55,PSGP,5,+PSGORD,10,II)) Q:'II!FOUND  D
 .S INTERVEN=$G(^PS(55,PSGP,5,+PSGORD,10,II,0)) S FOUND=$$INTCHK(+INTERVEN)
 I PSGORD["V" S II=0 F  S II=$O(^PS(55,PSGP,"IV",+PSGORD,8,II)) Q:'II!FOUND  D
 .S INTERVEN=$G(^PS(55,PSGP,"IV",+PSGORD,8,II,0)) S FOUND=$$INTCHK(+INTERVEN)
 Q FOUND
 ;
INTCHK(INT) ; If classification of specific intervention is CRITICAL DRUG or ALLERGY/ADR, return 1, otherwise return 0
 ; INPUT: INT - Intervention IEN from the APSP Intervention (#9009032.4) file
 Q:'$G(INT) 0
 K PSJCRAL S PSJCRAL=0
 I ",6,18,"[(","_$P($G(^APSPQA(32.4,+INT,0)),"^",7)_",") S PSJCRAL=1
 Q PSJCRAL
 ;
 W ! K PSJDSPLN S $P(PSJDSPLN,"=",76)="=" W !,PSJDSPLN S ILCNT=$G(ILCNT)+1
 S PSJL="** "_BANNER_" **" W !?PSJINDEN,PSJL,!,PSJDSPLN S ILCNT=$G(ILCNT)+2
 S PSJL=""
 Q
 ;
STOREINT ; Store Intervention pointer to Inpatient order
 Q:$G(ERR)=1
 I '$G(PSGORD) N PSGORD S PSGORD=$S($G(ON):ON,$G(PSJORD):PSJORD,1:"")
 Q:'PSGORD
 N ACT,X,Y,INTII,PSJINTFL,INTIINUM,PSJINVDT,PSIVKEEP S PSJINTFL=0
 I $G(PSGOORD)["U" S PSJINTFL=$G(^PS(55,PSGP,5,+PSGOORD,10,1,0)) I PSJINTFL,'$D(^TMP("PSJINTER",$J)) D
 .;Don't carry over old interventions if OI changed
 .I $G(PSGORD)["P" Q:(+$G(^PS(55,PSGP,5,+PSGOORD,.2))'=+$G(^PS(53.1,+PSGORD,.2)))
 .; Don't carry over old interventions if OI changed
 .I $G(PSGORD)["U" Q:(+$G(^PS(55,PSGP,5,+PSGOORD,.2))'=+$G(^PS(55,PSGP,5,+PSGORD,.2)))
 .S INTII="A" F  S INTII=$O(^PS(55,PSGP,5,+PSGOORD,10,INTII),-1) Q:'INTII  S INTIINUM=$G(^(INTII,0)) I INTIINUM S ^TMP("PSJINTER",$J,+INTIINUM)=$P(INTIINUM,"^",2)_"^"_+$G(^PS(55,PSGP,5,+PSGOORD,.2))
 I $G(PSGOORD)["P" S PSJINTFL=$G(^PS(53.1,+PSGOORD,11,1,0)) I PSJINTFL,'$D(^TMP("PSJINTER",$J)) D
 .I $G(PSGORD)["P" Q:(+$G(^PS(53.1,+PSGOORD,.2))'=+$G(^PS(53.1,+PSGORD,.2)))  ; Don't carry over old interventions if OI changed
 .I $G(PSGORD)["U" Q:(+$G(^PS(53.1,+PSGOORD,.2))'=+$G(^PS(55,PSGP,5,+PSGORD,.2)))  ; Don't carry over old interventions if OI changed
 .S INTII="A" F  S INTII=$O(^PS(53.1,+PSGOORD,11,INTII),-1) Q:'INTII  S INTIINUM=$G(^(INTII,0)) I INTIINUM S ^TMP("PSJINTER",$J,+INTIINUM)=$P(INTIINUM,"^",2)_"^"_+$G(^PS(53.1,+PSGOORD,.2))
 I $D(^TMP("PSJINTER",$J)),$G(PSGORD)["V",$D(^PS(55,PSGP,"IV",+PSGORD,8)) S PSIVKEEP=1 Q
 I $D(^TMP("PSJINTER",$J)) S PSJINTER=0 F  S PSJINTER=$O(^TMP("PSJINTER",$J,PSJINTER)) Q:'PSJINTER  D
 .N DR,DA,DIC,DIE,DD,DINUM,DO,KK N PSJOLIDT S PSJINVDT=+$G(^TMP("PSJINTER",$J,PSJINTER)) S:'PSJINVDT PSJINVDT=$G(PSGDT)
 .I ($G(PSGORD)["V") N PSJIVODT S PSJIVODT=+$G(^PS(55,PSGP,"IV",+PSGORD,2)) I +$G(PSJINVDT)>(PSJIVODT)&($$FMDIFF^XLFDT(PSJINVDT,PSJIVODT,2)>90) S PSIVKEEP=1 Q
 .I (PSGORD["V")!((PSGORD["P")&$D(^PS(53.1,+PSGORD,"AD"))) Q:'$$CHKADD^PSGSICH(PSJINTER,PSGP,PSGORD)
 .I PSGORD["P" D
 ..N IC,IG S (IG,IC)=0 F  Q:$G(IG)  S IC=$O(^PS(53.1,+PSGORD,11,IC)) Q:'IC!$G(IG)  S:(+$G(^PS(53.1,+PSGORD,11,IC,0))=+PSJINTER) IG=1
 ..Q:$G(IG)  S DIC="^PS(53.1,"_+PSGORD_",11,",KK=$P($G(^PS(53.1,+PSGORD,11,0)),"^",3)+1 S DIC(0)="L",DIC("P")="53.13PA",DINUM=KK,DA(2)=+PSGORD,DA(1)=KK
 ..S X=+PSJINTER S DIC("DR")=".01////"_+PSJINTER_";1////"_PSJINVDT_";" D FILE^DICN
 .I PSGORD["U" D
 ..S DIC="^PS(55,"_PSGP_",5,"_+PSGORD_",10," S KK=$P($G(^PS(55,PSGP,5,+PSGORD,10,0)),"^",3)+1 S DIC(0)="L",DIC("P")="55.6132PA"
 ..S DINUM=KK,DA(2)=PSGP,DA(1)=+PSGORD S X=+PSJINTER S DIC("DR")=".01////"_+PSJINTER_";1////"_PSJINVDT_";" D FILE^DICN
 .I PSGORD["V" D
 ..S DIC="^PS(55,"_PSGP_",""IV"","_+PSGORD_",8," S KK=$P($G(^PS(55,PSGP,"IV",+PSGORD,8,0)),"^",3)+1 S DIC(0)="L",DIC("P")="55.1153PA"
 ..S DINUM=KK,DA(2)=PSGP,DA(1)=+PSGORD S X=+PSJINTER S DIC("DR")=".01////"_+PSJINTER_";1////"_PSJINVDT_";" D FILE^DICN
 Q:$G(PSIVKEEP)
 K ^TMP("PSJINTER",$J)
 Q
 ;
SETIVINT ; Move intervention pointers from one order to another during finishing
 Q:$G(ERR)=1  ; Order failed validation, don't move interventions
 N DA,DIC,DR
 I $G(PSGORD)["P" D  K ^TMP("PSJINTER",$J) Q
 .I ($G(ON)["V")!($G(ON)["P") D SETIVIN2^PSGSICH(PSGORD,ON) Q
 I $G(PSJORD)["V" D
 .I $G(ON)["P"!(($G(ON)["V")&($G(ON)'=$G(PSJORD))) D SETIVIN2^PSGSICH(PSJORD,ON) Q
 I $G(PSJORD)["P" D
 .I ($G(ON)["V")!($G(ON)["P") D SETIVIN2^PSGSICH(PSJORD,ON) Q
 K ^TMP("PSJINTER",$J)
 Q
 ;
SETUDINT(PSJU1,PSJU2) ; Store Intervention pointers in the UD intervention multiple
 ; INPUT: PSJU1 - Inpatient order from which to copy intervention pointer(s)
 ;        PSJU2 - Inpatient order to copy intervention pointer(s) to
 Q:'$G(DFN)  N DA,DIC,PSJINTER,PSJINCNT,PSJNXTI,DO
 I '$G(PSGDT) N PSGDT D NOW^%DTC S PSGDT=+$E(%,1,12)
 I PSJU1["P" D
 .I $G(PSJU2)["P" I $D(^PS(53.1,+PSJU1,11,0)),$D(^PS(53.1,+$G(PSJU2),0)) S PSJINCNT=+$P($G(^PS(53.1,+PSJU2,11,0)),"^",3) D  Q
 ..S PSJNXTI=0 F  S PSJNXTI=$O(^PS(53.1,+$G(PSJU1),11,PSJNXTI)) Q:'PSJNXTI  S PSJINCNT=$G(PSJINCNT)+1 D
 ...S PSJINTER=$G(^PS(53.1,+$G(PSJU1),11,PSJNXTI,0)) Q:'PSJINTER  Q:$D(^PS(53.1,+PSJU2,11,"B",+PSJINTER))
 ...S DIC="^PS(53.1,"_+PSJU2_",11,",DIC(0)="L",DIC("P")="53.13PA",DINUM=PSJINCNT,DA(1)=+PSJU2,DA=PSJINCNT
 ...S X=+PSJINTER,DIC("DR")=".01////"_+PSJINTER_";1////"_$G(PSGDT)_";" D FILE^DICN
 .I '$G(PSJU2) S PSJU2=$P($G(^PS(53.1,+PSJU1,0)),"^",19) Q:'PSJU2  S PSJU2=PSJU2_"U"
 .Q:(+$G(^PS(53.1,+PSJU1,.2))'=+$G(^PS(55,DFN,5,+PSJU2,.2)))  ; Don't carry over old interventions if OI changed
 .I $D(^PS(53.1,+PSJU1,11,0)),$D(^PS(55,DFN,5,+PSJU2,0)) S PSJINCNT=+$P($G(^PS(55,DFN,5,+PSJU2,10,0)),"^",3) D
 ..S PSJNXTI=0 F  S PSJNXTI=$O(^PS(53.1,+$G(PSJU1),11,PSJNXTI)) Q:'PSJNXTI  S PSJINCNT=$G(PSJINCNT)+1 D
 ...S PSJINTER=$G(^PS(53.1,+$G(PSJU1),11,PSJNXTI,0)) Q:'PSJINTER  Q:$D(^PS(55,DFN,5,+$G(PSJU2),10,"B",+PSJINTER))
 ...S DIC="^PS(55,"_+DFN_",5,"_+PSJU2_",10,",DIC(0)="L",DIC("P")="55.6132PA",DA(1)=+PSJU2,DA(2)=DFN,(DINUM,X)=+PSJINCNT
 ...S DIC("DR")=".01////"_+PSJINTER_";1////"_$P(PSJINTER,"^",2)_";" D FILE^DICN
 K ^TMP("PSJINTER",$J)
 Q
 ;
ASKDISP() ; If Provider Overrides or Pharmacy Interventions exist, prompt user to display all.
 N DIR,X,Y
 I $G(PSJORD) Q:'$$OVRCHK($G(DFN),PSJORD) 0
 I $G(PSJNEWOE),'$$ORDEXIST^PSGSICH(DFN,PSJORD) Q 0
 W ! S DIR(0)="E",DIR("A")="Order Check Overrides/Interventions exist for this order. Display? (Y/N)",DIR("B")="Y",DIR(0)="Y" D ^DIR S:$G(Y)="" Y=1
 Q $S(Y=1:1,1:0)