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