- PSJOC ;BIR/MV - NEW ORDER CHECKS DRIVER ; 9/10/14 10:53pm
- ;;5.0;INPATIENT MEDICATIONS;**181,260,252,257,281,256,364,426**;16 DEC 97;Build 4
- ;
- ; Reference to ^PSODDPR4 is supported by DBIA# 5366.
- ; Reference to ^PSSHRQ2 is supported by DBIA# 5369.
- ;
- ;*364 - add Hazardous Handle & Dispose flags alert message.
- ;
- OC(PSPDRG,PSJPTYP) ;
- ;PSPDRG - Drug array in format of PDRG(n)=IEN (#50) ^ Drug Name
- ;Where n is a sequential number. The Drug Name can be OI, Generic name from #50, or Add/Sol name
- ;PSJPTYP - P1 ; P2
- ; Where P1 is "I" for Inpatient, "O" for Outpatient
- ; P2 is the Inpatient Order Number (for PSJ use only)
- ;PSJOCERR(DRUG NAME)="Reason text". Where Drug Name can be either OI name or AD/SOL name.
- NEW PSJOCERR
- ;Quit OC if FDB link is down. PSGORQF is defined if user wish to stop the order process
- I $$SYS^PSJOCERR() Q
- ;
- I $D(PSJDGCK) W !!,"Building MEDS profile please wait...",!
- D BLD^PSODDPR4(DFN,"PSJPRE",.PSPDRG,PSJPTYP)
- D DISPLAY
- K ^TMP($J,"PSJPRE")
- Q
- DISPLAY ;
- NEW PSJPAUSE,PSJOLDSV,PSJDNM,PSJMON,PSJOC,PSJOCDT,PSJOCDTL,PSJOCLST,PSJP,PSJS,PSJPON,PSJDN,PSJSEV,PSJECNT
- N CROCLN,CROCLN2,PSJTOFFL,PSJCROCF,PSJDRGIF,PSJDERF2,PSJDUPTF
- D FULL^VALM1 W @IOF
- D GMRAOC Q:$G(PSGORQF)
- S $P(CROCLN,"=",75)="=",$P(CROCLN2,"-",75)="-",CROCNR=1
- I '$D(PSJDGCKX) D
- .I '$D(TMPDRG1("AD",0))&('$D(TMPDRG1("SOL",0)))&($G(PSPDRG(1))) D CK^PSJCROC($P(PSPDRG(1),"^")) I $G(PSGORQF) Q
- .I $G(TMPDRG1("AD",0))>0!$G(TMPDRG1("SOL",0))>0 W "Now processing Clinical Reminder Order Checks. Please wait ..."
- .I $G(TMPDRG1("AD",0))>0 F CRIV=0:0 S CRIV=$O(TMPDRG1("AD",CRIV)) Q:'CRIV D CKIV^PSJCROC($P(TMPDRG1("AD",CRIV),"^",1),"A")
- .I $G(TMPDRG1("SOL",0))>0 F CRIV=0:0 S CRIV=$O(TMPDRG1("SOL",CRIV)) Q:'CRIV D CKIV^PSJCROC($P(TMPDRG1("SOL",CRIV),"^",1),"S")
- .I $G(TMPDRG1("AD",0))>0!$G(TMPDRG1("SOL",0))>0 D CKIVD^PSJCROC I $G(PSGORQF) S VALMBCK="R" Q
- K CRIV,CROCPFLG,CROCNR,PSJDGCKX
- I $G(PSGORQF) Q
- Q:'$$DSPSERR()
- W !!,"Now Processing Enhanced Order Checks! Please wait...",! S PSJTOFFL=1
- ; If there are no OC or errors to display, this var will trigger a pause before continue /w the order
- S PSJPAUSE=1
- D DRUGERR
- I $D(PSJDGCK) W:'$D(^TMP($J,"PSJPRE","OUT","DRUGDRUG"))&'$D(^TMP($J,"PSJPRE","OUT","THERAPY",1)) !,"No Order Check Warnings Found",!
- ;Process drug interaction & drug interception
- D DI^PSJOCDI
- Q:$G(PSGORQF)
- D DSPERR^PSJOCERR("DRUGDRUG")
- ;Process duplicate therapy order checks
- D:'$D(PSJDGCK) DT^PSJOCDT
- I $D(PSJDGCK) D:$D(^TMP($J,"PSJPRE","OUT","THERAPY")) DTDGCK^PSJOCDT
- D:'$G(PSGORQF) DSPERR^PSJOCERR("THERAPY")
- I '$G(PSJTOFFL) W !!,"Now Processing Enhanced Order Checks! Please wait...",! I $G(PSIVCOPY)&('$D(PSJDGCK)) D PAUSE^PSJLMUT1
- I $D(PSJDGCK),'$D(^TMP($J,"PSJPRE","OUT","THERAPY")) D PAUSE^PSJLMUT1 Q ;DX action
- Q:$G(PSGORQF)
- I '$G(PSJDERF2)&('$G(PSJDRGIF))&('$G(PSJDUPTF)) K PSJPAUSE H 2
- I $G(PSJDERF2)&('$G(PSJDRGIF))&('$G(PSJDUPTF))&(($Y+3)<IOSL) S PSJPAUSE=1 ;error but no drug interaction or dup therapy
- I '$D(PSJDGCK) D:$G(PSJPAUSE) PAUSE^PSJLMUT1
- Q
- ;
- GMRAOC ;Display allergy & CPRS OC regardless if FDB is connected
- D HAZCHK ;Add Hazardous to Handle/Dispose warning messages *364
- D ALLERGY Q:$G(PSGORQF)
- D CPRS^PSJOCOR(.PSPDRG)
- Q
- ALLERGY ;Do allergy order check
- ;The allergy check will be processed for each of the dispense drug stores in the PSJALLGY array
- ;PSJALLGY(X)="" Where X is the disp drug IEN. PSJALLGY array store all dispense drugs use in an order
- ;
- D FULL^VALM1
- I $G(PSIALLFL) K PSIALLFL Q
- W !!,"Now doing allergy checks. Please wait..."
- N PSJAOC,DACNT,PSJDGFLG,PSJDGDRG S PSJAOC=1
- I '$D(PSJDGCK) D ;sort by generic dispensed drug name
- .NEW PSJDD,PSJGDDN,PSJALGCT,PSJALLGS S PSJDD=""
- .F S PSJDD=$O(PSJALLGY(PSJDD)) Q:'PSJDD!(PSJDD'?1N.N) S PSJGDDN="",PSJGDDN=$$GET1^DIQ(50,PSJDD,.01) D
- ..I PSJGDDN="" S PSJALLGY("AA",PSJDD_"Z",PSJDD)="" Q
- ..S PSJALLGY("AA",PSJGDDN,PSJDD)=""
- .S (PSJDD,PSJGGDN)=""
- .F S PSJGGDN=$O(PSJALLGY("AA",PSJGGDN)) Q:PSJGGDN=""!($G(PSGORQF)) F S PSJDD=$O(PSJALLGY("AA",PSJGGDN,PSJDD)) Q:PSJDD=""!($G(PSGORQF)) D
- ..S PSJALGCT=$G(PSJALGCT)+1 D EN^PSJGMRA(DFN,PSJDD)
- K PSJALLGY("AA")
- I $D(PSJDGCK) D ;CK ACTION
- .S PSJXX="" F S PSJXX=$O(PSJALLGY(PSJXX)) Q:PSJXX=""!(PSJXX'?1N.N) D
- ..S PSJGDDN="",PSJGDDN=$$GET1^DIQ(50,PSJXX,.01)
- ..I PSJGDDN="" S PSJALLGY($S(PSJALLGY(PSJXX)="P":"A",1:"Z"),PSJDD_"Z",PSJGDDN,PSJXX)="" Q
- ..S PSJALLGY($S(PSJALLGY(PSJXX)="P":"A",1:"Z"),PSJGDDN,PSJXX)=""
- .S (PSJALLGS,PSJXX,PSJGDDN)="",(PSJDGFLG,PSJYY)=1
- .F S PSJXX=$O(^TMP($J,"PSJPRE","IN","PROSPECTIVE",PSJXX)) Q:PSJXX="" D
- ..S PSJCKDRG=$P(^TMP($J,"PSJPRE","IN","PROSPECTIVE",PSJXX),U,3)
- ..S PSJGDDN=$$GET1^DIQ(50,PSJCKDRG,.01)
- ..S PSJALLGY($S($G(PSJALLGY(PSJCKDRG))="P":"A",1:"Z"),PSJGDDN_"Z",PSJCKDRG)=""
- ..I $G(PSJALLGY(PSJCKDRG))="P",$D(PSJALLGY("A",PSJGDDN,PSJCKDRG)) K PSJALLGY("A",PSJGDDN,PSJCKDRG)
- ..I $D(PSJALLGY(PSJCKDRG)) K PSJALLGY(PSJCKDRG)
- .S (PSJCC,PSJDD)=""
- .;CK action - If the manually entered drug is same as a profile drug, display as a profile drug.
- .F S PSJDD=$O(PSJALLGY("A",PSJDD)) Q:PSJDD="" F S PSJCC=$O(PSJALLGY("A",PSJDD,PSJCC)) Q:PSJCC="" D
- ..I $D(PSJALLGY("Z",PSJDD,PSJCC)) K PSJALLGY("A",PSJDD,PSJCC)
- .S (PSJALLGS,PSJDD,PSJCC)=""
- .F S PSJALLGS=$O(PSJALLGY(PSJALLGS)) Q:PSJALLGS="" F S PSJCC=$O(PSJALLGY(PSJALLGS,PSJCC)) Q:PSJCC=""!($G(PSGORQF)) D
- ..F S PSJDD=$O(PSJALLGY(PSJALLGS,PSJCC,PSJDD)) Q:PSJDD=""!($G(PSGORQF)) S:PSJALLGS="A" PSJDGFLG=0 D EN^PSJGMRA(DFN,PSJDD) S PSJDGFLG=1
- K PSJXX,PSJYY,PSJDD,PSJCC,PSJALLGY,DACNT,PSJGGDN
- Q
- DSPORD(ON,PSJNLST,PSJCLINF) ;Display the order data
- ;ON - ON_U/V/P ex: 21V
- ;PSJNLST - It's number list and also use to trigger pg break, line break
- NEW PSJCOL,PSJX,PSJOC,PSJLINE,X
- Q:ON=""
- S:'$D(PSJCLINF) PSJCLINF=";0"
- S PSJLINE=1,PSJCOL=1
- I $P(PSJCLINF,";",2) D CLNDISP^PSJCLNOC(.PSJCLINF) D Q
- .I $G(PSJNLST)="",(($Y+6)>IOSL) D PAUSE^PSJLMUT1 W @IOF
- I ON'["V" D DSPLORDU^PSJLMUT1(DFN,ON)
- I ON["V" D DSPLORDV^PSJLMUT1(DFN,ON)
- F PSJX=0:0 S PSJX=$O(PSJOC(ON,PSJX)) Q:'PSJX D
- . I $G(PSJNLST)="",(($Y+6)>IOSL) D PAUSE^PSJLMUT1 W @IOF
- . W !
- . I $G(PSJNLST) W:(PSJX=1) PSJNLST W:(PSJX>1) ?$L(PSJNLST)
- . S X=PSJOC(ON,PSJX)
- . W $E(X,9,$L(X))
- W !
- Q
- ;
- DRUGERR ;Display drug level errors
- NEW PSJPON,PSJN,PSJNV,PSJDSPFG,PSJPERR,PSJX,PSJLINEF
- ;Only display the exceptions once per patient. Use the exception from prospective drug if exception(s) existed for the
- ; same drug on the profile.
- ;PSJEXCPT(PSJDNM_REASON) - Array for invalid drugs that already display to once within a pt selection
- S PSJDSPFG=0
- S PSJPERR=$$PROSPERR()
- I PSJPERR D Q
- . I PSJDSPFG D PAUSE^PSJLMUT1
- I $D(PSJEXCPT("PROFILE")),'$G(PSJDGCK) Q
- S PSJPON="" F S PSJPON=$O(^TMP($J,"PSJPRE","OUT","EXCEPTIONS",PSJPON)) Q:PSJPON="" D
- . F PSJN=0:0 S PSJN=$O(^TMP($J,"PSJPRE","OUT","EXCEPTIONS",PSJPON,PSJN)) Q:'PSJN D
- .. I '$G(PSJLINEF) W ! S PSJLINEF=1
- .. S PSJNV=$G(^TMP($J,"PSJPRE","OUT","EXCEPTIONS",PSJPON,PSJN))
- .. ;I ($P(PSJPON,";",3)="PROSPECTIVE") S PSJX='$$ERRCHK("PROSPECTIVE",$P(PSJNV,U,3)_$P(PSJNV,U,10))
- .. I ($P(PSJPON,";",3)'="PROFILE") Q
- .. I '$$ERRCHK("PROFILE",$P(PSJNV,U,3)_$P(PSJNV,U,10)) Q
- .. D DSPDRGER()
- I PSJDSPFG D PAUSE^PSJLMUT1 S PSJDERR2=1
- Q
- DSPDRGER(PSJDSFLG) ;
- NEW PSJTXT
- S PSJTXT=$P(PSJNV,U,7)
- ;W:$G(PSGCOPY)!($G(PSIVCOPY)) !
- S X="Enhanced Order Checks cannot "
- I $G(PSJDSFLG),(PSJTXT[X) S PSJTXT="Dosing Checks could not "_$P(PSJTXT,X,2)
- S PSJDSPFG=1
- K PSJPAUSE
- I ($Y+6)>IOSL D PAUSE^PSJLMUT1 W @IOF
- W !
- D WRITE^PSJMISC(PSJTXT,,79)
- I $P(PSJNV,U,10)]"" D WRITE^PSJMISC("Reason(s): "_$P(PSJNV,U,10),3,79) S PSJDERF2=1
- ;W !
- Q
- ERRCHK(PSJTYPE,PSJX) ;
- ;PSJTYPE - Either "PROFILE" or "PROSPECTIVE"
- ;PSJX - Drug name_Error reason
- ;Return 1 if this error drug has not displayed to the user.
- I $G(PSJX)="" Q 0
- I $G(PSJTYPE)="" Q 0
- ;I PSJTYPE="PROFILE",'$D(PSJEXCPT(PSJTYPE,PSJX)) S PSJEXCPT(PSJTYPE,PSJX)="" Q 1
- I PSJTYPE="PROFILE" S PSJEXCPT(PSJTYPE,PSJX)="" Q 1
- I PSJTYPE="PROSPECTIVE",'$D(PSJEXCPT(PSJTYPE,PSJX)) S PSJEXCPT(PSJTYPE,PSJX)="" Q 1
- Q 0
- PING(PSJMSG) ;Check if FDB is down. Return 0 if it is
- ;pass in a message to customize the display
- S ^TMP($J,"PSJPRE","IN","PING")=""
- D IN^PSSHRQ2("PSJPRE")
- Q $$DSPSERR($G(PSJMSG))
- DSPSERR(PSJMSG) ;Display system errors
- NEW X
- S X=$G(^TMP($J,"PSJPRE","OUT",0))
- I $P(X,U)=-1 D NOFDB($P(X,U,2),$G(PSJMSG))
- Q $S($P(X,U)=-1:0,1:1)
- NOFDB(PSJX,PSJMSG) ;Display connection down message
- NEW X
- Q:$G(PSJX)=""
- I $G(PSJMSG)]"" W !!,PSJMSG
- I $G(PSJMSG)="" W !!,"No Enhanced Order Checks can be performed."
- W !," Reason(s): ",PSJX,!!
- K PSJX
- D:$G(PSJMSG)]"" PAUSE^PSJLMUT1
- Q
- PROSPERR() ;Display exceptions for prospective drug
- NEW PSJPON,PSJN,PSJNV,PSJPERR
- ;If all prospectives are caught in the exception then display them only and omit the profile drugs
- S PSJPON="" F S PSJPON=$O(^TMP($J,"PSJPRE","OUT","EXCEPTIONS",PSJPON)) Q:PSJPON="" D
- . F PSJN=0:0 S PSJN=$O(^TMP($J,"PSJPRE","OUT","EXCEPTIONS",PSJPON,PSJN)) Q:'PSJN D
- .. S PSJNV=$G(^TMP($J,"PSJPRE","OUT","EXCEPTIONS",PSJPON,PSJN))
- .. I $P(PSJPON,";",3)="PROFILE" Q
- .. I ($P(PSJPON,";",3)="PROSPECTIVE") S PSJX='$$ERRCHK("PROSPECTIVE",$P(PSJNV,U,3)_$P(PSJNV,U,10))
- .. D DSPDRGER() S PSJDSPFG=1
- ;If the prospective drug(s) is caught in the exception, the exception for profile drug(s) is not display.
- ; The exception for the prospective is the only one need to display.
- S PSJPERR=1
- S PSJPON="" F S PSJPON=$O(^TMP($J,"PSJPRE","IN","PROSPECTIVE",PSJPON)) Q:PSJPON="" D
- . I $D(^TMP($J,"PSJPRE","OUT","EXCEPTIONS",PSJPON)) Q
- . S (PSJDSPFG,PSJPERR)=0
- Q PSJPERR
- ;
- HAZCHK ;Check for a hazardous drug component and display soft error type warning roll and scroll alert *364
- N PSORDN,HDG,HAZ,HAZH,HAZD,HZAR,HTXT,LL,DRGIEN,TOP
- S (HAZH,HAZD)=0
- I $G(ON),'$G(PSGDRG),(($G(NAME)["PSJ LM UD")!($G(NAME)["PSJU LM")!($G(NAME)["PSJ LM PENDING")) D ;Unit Dose
- . I $G(PSGORD)["P" S PSORDN="^PS(53.1,"_+PSGORD_","
- . I '$G(PSGORD),ON["P" S PSORDN="^PS(53.1,"_+ON_","
- . I $G(PSGORD),ON["U" S PSORDN="^PS(55,"_DFN_",5,"_+ON_","
- . Q:'$D(PSORDN)
- . D HAZDRUG(PSORDN,.HZAR)
- I '$D(PSJALLGY),$G(PSGDRG),$G(NAME)'["PSJ LM IV" D ;IV new dispense only
- . S HZAR(PSGDRG)=$$HAZ^PSSUTIL(PSGDRG)
- I '$D(PSJALLGY),$G(PSJORD),$G(NAME)["PSJ LM IV" D ;IV pending or edit
- . S:PSJORD["P" PSORDN="^PS(53.1,"_+PSJORD_","
- . S:PSJORD["V" PSORDN="^PS(55,"_DFN_",""IV"","_+PSJORD_","
- . Q:'$D(PSORDN)
- . D HAZDRUG(PSORDN,.HZAR)
- I $D(PSJALLGY) F DRGIEN=0:0 S DRGIEN=$O(PSJALLGY(DRGIEN)) Q:'DRGIEN D ;IV new order add mix
- . S HZAR(DRGIEN)=$$HAZ^PSSUTIL(DRGIEN)
- ;display warning text(s)
- S HAZ=0,HDG=1,$P(LL,"-",80)="-"
- F DRGIEN=0:0 S DRGIEN=$O(HZAR(DRGIEN)) Q:'DRGIEN D
- . S HAZH=$P(HZAR(DRGIEN),U),HAZD=$P(HZAR(DRGIEN),U,2)
- . Q:'(HAZH!HAZD)!('$D(DRGIEN))
- . D HAZWARNG^PSSUTIL(DRGIEN,"I",HAZH,HAZD,.HTXT) S HAZ=1
- . I HDG W #,$C(7),LL,!,$J("***** WARNING *****",47) S HDG=0 ;header
- . D WRAPTEXT(HTXT,65,5) W ! ;body
- D:HAZ ;footer
- . W LL,!
- . K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR
- Q
- ;
- HAZDRUG(FILE,AR) ;Get Hazardous to Handle and Hazardous to Dispose fields per component and return Haz array by DRUG IEN *364
- ; FILE = file root + Order Num from inpatient variables during workflow; Example VAR contains: "^PS(55,DFN,5,ON," or "(PS(53.1,ON," or "^PS(55,DFN,"IV",ON,"
- ; (build ROOT to the multiple level to find all Disp Drugs or Additives or Solution and get HAZ flags)
- ; AR = array of component's IEN and their Haz flag settings
- N QQ,ROOT,NXTROOT,NXT,IFN,GL
- ;check IF Unit Dose Disp Drug exists for this order, then get IEN(s) and Haz flags
- I FILE[",5," F QQ=0:0 S ROOT=FILE_"1,"_QQ_")" S QQ=$O(@ROOT) Q:'QQ D
- . S NXTROOT=FILE_"1,"_QQ_")" S NXT=$O(@NXTROOT) S GL=$E(NXTROOT,1,$L(ROOT)-1),IFN=+@(GL_",0)")
- . S AR(IFN)=$$HAZ^PSSUTIL(IFN)
- . ;check IF IV additives exist for this order, then get IEN(s) and Haz flags
- I FILE[",""IV""," F QQ=0:0 S ROOT=FILE_"""AD"","_QQ_")" S QQ=$O(@ROOT) Q:'QQ D
- . S NXTROOT=FILE_"""AD"","_QQ_")" S NXT=$O(@NXTROOT) S GL=$E(NXTROOT,1,$L(ROOT)-1),IFN=+@(GL_",0)")
- . I IFN S IFN=+$P($G(^PS(52.6,IFN,0)),U,2),AR(IFN)=$$HAZ^PSSUTIL(IFN)
- . ;check IF IV solutions exist for this order, then get IEN(s) and Haz flags
- I FILE[",""IV""," F QQ=0:0 S ROOT=FILE_"""SOL"","_QQ_")" S QQ=$O(@ROOT) Q:'QQ D
- . S NXTROOT=FILE_"""SOL"","_QQ_")" S NXT=$O(@NXTROOT) S GL=$E(NXTROOT,1,$L(ROOT)-1),IFN=+@(GL_",0)")
- . I IFN S IFN=+$P($G(^PS(52.7,IFN,0)),U,2),AR(IFN)=$$HAZ^PSSUTIL(IFN)
- Q
- ;
- WRAPTEXT(TEXT,LIMIT,CSPACES) ;Wrap text util copied in from a PSO routine originally *364
- ;;FUNCTION TO DISPLAY (WRITE) TEXT WRAPPED TO A CERTAIN COLUMN LENGTH
- ;;DEFAULT=74 CHARACTERS WITH NO SPACES IN FRONT
- N WORDS,COUNT,LINE,NEXTWORD
- Q:$G(TEXT)']"" ""
- S LIMIT=$G(LIMIT,74)
- S CSPACES=$S($G(CSPACES):CSPACES,1:0)
- S WORDS=$L(TEXT," ")
- W !,$$REPEAT^XLFSTR(" ",CSPACES)
- F COUNT=1:1:WORDS D
- . S NEXTWORD=$P(TEXT," ",COUNT)
- . Q:NEXTWORD="" ;TO REMOVE LEADING OR DOUBLE SPACES
- . S LINE=$G(LINE)_NEXTWORD_" "
- . I $L($G(LINE))>LIMIT W !,$$REPEAT^XLFSTR(" ",CSPACES) K LINE
- . W NEXTWORD_" "
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJOC 13589 printed Jan 18, 2025@03:09:12 Page 2
- PSJOC ;BIR/MV - NEW ORDER CHECKS DRIVER ; 9/10/14 10:53pm
- +1 ;;5.0;INPATIENT MEDICATIONS;**181,260,252,257,281,256,364,426**;16 DEC 97;Build 4
- +2 ;
- +3 ; Reference to ^PSODDPR4 is supported by DBIA# 5366.
- +4 ; Reference to ^PSSHRQ2 is supported by DBIA# 5369.
- +5 ;
- +6 ;*364 - add Hazardous Handle & Dispose flags alert message.
- +7 ;
- OC(PSPDRG,PSJPTYP) ;
- +1 ;PSPDRG - Drug array in format of PDRG(n)=IEN (#50) ^ Drug Name
- +2 ;Where n is a sequential number. The Drug Name can be OI, Generic name from #50, or Add/Sol name
- +3 ;PSJPTYP - P1 ; P2
- +4 ; Where P1 is "I" for Inpatient, "O" for Outpatient
- +5 ; P2 is the Inpatient Order Number (for PSJ use only)
- +6 ;PSJOCERR(DRUG NAME)="Reason text". Where Drug Name can be either OI name or AD/SOL name.
- +7 NEW PSJOCERR
- +8 ;Quit OC if FDB link is down. PSGORQF is defined if user wish to stop the order process
- +9 IF $$SYS^PSJOCERR()
- QUIT
- +10 ;
- +11 IF $DATA(PSJDGCK)
- WRITE !!,"Building MEDS profile please wait...",!
- +12 DO BLD^PSODDPR4(DFN,"PSJPRE",.PSPDRG,PSJPTYP)
- +13 DO DISPLAY
- +14 KILL ^TMP($JOB,"PSJPRE")
- +15 QUIT
- DISPLAY ;
- +1 NEW PSJPAUSE,PSJOLDSV,PSJDNM,PSJMON,PSJOC,PSJOCDT,PSJOCDTL,PSJOCLST,PSJP,PSJS,PSJPON,PSJDN,PSJSEV,PSJECNT
- +2 NEW CROCLN,CROCLN2,PSJTOFFL,PSJCROCF,PSJDRGIF,PSJDERF2,PSJDUPTF
- +3 DO FULL^VALM1
- WRITE @IOF
- +4 DO GMRAOC
- if $GET(PSGORQF)
- QUIT
- +5 SET $PIECE(CROCLN,"=",75)="="
- SET $PIECE(CROCLN2,"-",75)="-"
- SET CROCNR=1
- +6 IF '$DATA(PSJDGCKX)
- Begin DoDot:1
- +7 IF '$DATA(TMPDRG1("AD",0))&('$DATA(TMPDRG1("SOL",0)))&($GET(PSPDRG(1)))
- DO CK^PSJCROC($PIECE(PSPDRG(1),"^"))
- IF $GET(PSGORQF)
- QUIT
- +8 IF $GET(TMPDRG1("AD",0))>0!$GET(TMPDRG1("SOL",0))>0
- WRITE "Now processing Clinical Reminder Order Checks. Please wait ..."
- +9 IF $GET(TMPDRG1("AD",0))>0
- FOR CRIV=0:0
- SET CRIV=$ORDER(TMPDRG1("AD",CRIV))
- if 'CRIV
- QUIT
- DO CKIV^PSJCROC($PIECE(TMPDRG1("AD",CRIV),"^",1),"A")
- +10 IF $GET(TMPDRG1("SOL",0))>0
- FOR CRIV=0:0
- SET CRIV=$ORDER(TMPDRG1("SOL",CRIV))
- if 'CRIV
- QUIT
- DO CKIV^PSJCROC($PIECE(TMPDRG1("SOL",CRIV),"^",1),"S")
- +11 IF $GET(TMPDRG1("AD",0))>0!$GET(TMPDRG1("SOL",0))>0
- DO CKIVD^PSJCROC
- IF $GET(PSGORQF)
- SET VALMBCK="R"
- QUIT
- End DoDot:1
- +12 KILL CRIV,CROCPFLG,CROCNR,PSJDGCKX
- +13 IF $GET(PSGORQF)
- QUIT
- +14 if '$$DSPSERR()
- QUIT
- +15 WRITE !!,"Now Processing Enhanced Order Checks! Please wait...",!
- SET PSJTOFFL=1
- +16 ; If there are no OC or errors to display, this var will trigger a pause before continue /w the order
- +17 SET PSJPAUSE=1
- +18 DO DRUGERR
- +19 IF $DATA(PSJDGCK)
- if '$DATA(^TMP($JOB,"PSJPRE","OUT","DRUGDRUG"))&'$DATA(^TMP($JOB,"PSJPRE","OUT","THERAPY",1))
- WRITE !,"No Order Check Warnings Found",!
- +20 ;Process drug interaction & drug interception
- +21 DO DI^PSJOCDI
- +22 if $GET(PSGORQF)
- QUIT
- +23 DO DSPERR^PSJOCERR("DRUGDRUG")
- +24 ;Process duplicate therapy order checks
- +25 if '$DATA(PSJDGCK)
- DO DT^PSJOCDT
- +26 IF $DATA(PSJDGCK)
- if $DATA(^TMP($JOB,"PSJPRE","OUT","THERAPY"))
- DO DTDGCK^PSJOCDT
- +27 if '$GET(PSGORQF)
- DO DSPERR^PSJOCERR("THERAPY")
- +28 IF '$GET(PSJTOFFL)
- WRITE !!,"Now Processing Enhanced Order Checks! Please wait...",!
- IF $GET(PSIVCOPY)&('$DATA(PSJDGCK))
- DO PAUSE^PSJLMUT1
- +29 ;DX action
- IF $DATA(PSJDGCK)
- IF '$DATA(^TMP($JOB,"PSJPRE","OUT","THERAPY"))
- DO PAUSE^PSJLMUT1
- QUIT
- +30 if $GET(PSGORQF)
- QUIT
- +31 IF '$GET(PSJDERF2)&('$GET(PSJDRGIF))&('$GET(PSJDUPTF))
- KILL PSJPAUSE
- HANG 2
- +32 ;error but no drug interaction or dup therapy
- IF $GET(PSJDERF2)&('$GET(PSJDRGIF))&('$GET(PSJDUPTF))&(($Y+3)<IOSL)
- SET PSJPAUSE=1
- +33 IF '$DATA(PSJDGCK)
- if $GET(PSJPAUSE)
- DO PAUSE^PSJLMUT1
- +34 QUIT
- +35 ;
- GMRAOC ;Display allergy & CPRS OC regardless if FDB is connected
- +1 ;Add Hazardous to Handle/Dispose warning messages *364
- DO HAZCHK
- +2 DO ALLERGY
- if $GET(PSGORQF)
- QUIT
- +3 DO CPRS^PSJOCOR(.PSPDRG)
- +4 QUIT
- ALLERGY ;Do allergy order check
- +1 ;The allergy check will be processed for each of the dispense drug stores in the PSJALLGY array
- +2 ;PSJALLGY(X)="" Where X is the disp drug IEN. PSJALLGY array store all dispense drugs use in an order
- +3 ;
- +4 DO FULL^VALM1
- +5 IF $GET(PSIALLFL)
- KILL PSIALLFL
- QUIT
- +6 WRITE !!,"Now doing allergy checks. Please wait..."
- +7 NEW PSJAOC,DACNT,PSJDGFLG,PSJDGDRG
- SET PSJAOC=1
- +8 ;sort by generic dispensed drug name
- IF '$DATA(PSJDGCK)
- Begin DoDot:1
- +9 NEW PSJDD,PSJGDDN,PSJALGCT,PSJALLGS
- SET PSJDD=""
- +10 FOR
- SET PSJDD=$ORDER(PSJALLGY(PSJDD))
- if 'PSJDD!(PSJDD'?1N.N)
- QUIT
- SET PSJGDDN=""
- SET PSJGDDN=$$GET1^DIQ(50,PSJDD,.01)
- Begin DoDot:2
- +11 IF PSJGDDN=""
- SET PSJALLGY("AA",PSJDD_"Z",PSJDD)=""
- QUIT
- +12 SET PSJALLGY("AA",PSJGDDN,PSJDD)=""
- End DoDot:2
- +13 SET (PSJDD,PSJGGDN)=""
- +14 FOR
- SET PSJGGDN=$ORDER(PSJALLGY("AA",PSJGGDN))
- if PSJGGDN=""!($GET(PSGORQF))
- QUIT
- FOR
- SET PSJDD=$ORDER(PSJALLGY("AA",PSJGGDN,PSJDD))
- if PSJDD=""!($GET(PSGORQF))
- QUIT
- Begin DoDot:2
- +15 SET PSJALGCT=$GET(PSJALGCT)+1
- DO EN^PSJGMRA(DFN,PSJDD)
- End DoDot:2
- End DoDot:1
- +16 KILL PSJALLGY("AA")
- +17 ;CK ACTION
- IF $DATA(PSJDGCK)
- Begin DoDot:1
- +18 SET PSJXX=""
- FOR
- SET PSJXX=$ORDER(PSJALLGY(PSJXX))
- if PSJXX=""!(PSJXX'?1N.N)
- QUIT
- Begin DoDot:2
- +19 SET PSJGDDN=""
- SET PSJGDDN=$$GET1^DIQ(50,PSJXX,.01)
- +20 IF PSJGDDN=""
- SET PSJALLGY($SELECT(PSJALLGY(PSJXX)="P":"A",1:"Z"),PSJDD_"Z",PSJGDDN,PSJXX)=""
- QUIT
- +21 SET PSJALLGY($SELECT(PSJALLGY(PSJXX)="P":"A",1:"Z"),PSJGDDN,PSJXX)=""
- End DoDot:2
- +22 SET (PSJALLGS,PSJXX,PSJGDDN)=""
- SET (PSJDGFLG,PSJYY)=1
- +23 FOR
- SET PSJXX=$ORDER(^TMP($JOB,"PSJPRE","IN","PROSPECTIVE",PSJXX))
- if PSJXX=""
- QUIT
- Begin DoDot:2
- +24 SET PSJCKDRG=$PIECE(^TMP($JOB,"PSJPRE","IN","PROSPECTIVE",PSJXX),U,3)
- +25 SET PSJGDDN=$$GET1^DIQ(50,PSJCKDRG,.01)
- +26 SET PSJALLGY($SELECT($GET(PSJALLGY(PSJCKDRG))="P":"A",1:"Z"),PSJGDDN_"Z",PSJCKDRG)=""
- +27 IF $GET(PSJALLGY(PSJCKDRG))="P"
- IF $DATA(PSJALLGY("A",PSJGDDN,PSJCKDRG))
- KILL PSJALLGY("A",PSJGDDN,PSJCKDRG)
- +28 IF $DATA(PSJALLGY(PSJCKDRG))
- KILL PSJALLGY(PSJCKDRG)
- End DoDot:2
- +29 SET (PSJCC,PSJDD)=""
- +30 ;CK action - If the manually entered drug is same as a profile drug, display as a profile drug.
- +31 FOR
- SET PSJDD=$ORDER(PSJALLGY("A",PSJDD))
- if PSJDD=""
- QUIT
- FOR
- SET PSJCC=$ORDER(PSJALLGY("A",PSJDD,PSJCC))
- if PSJCC=""
- QUIT
- Begin DoDot:2
- +32 IF $DATA(PSJALLGY("Z",PSJDD,PSJCC))
- KILL PSJALLGY("A",PSJDD,PSJCC)
- End DoDot:2
- +33 SET (PSJALLGS,PSJDD,PSJCC)=""
- +34 FOR
- SET PSJALLGS=$ORDER(PSJALLGY(PSJALLGS))
- if PSJALLGS=""
- QUIT
- FOR
- SET PSJCC=$ORDER(PSJALLGY(PSJALLGS,PSJCC))
- if PSJCC=""!($GET(PSGORQF))
- QUIT
- Begin DoDot:2
- +35 FOR
- SET PSJDD=$ORDER(PSJALLGY(PSJALLGS,PSJCC,PSJDD))
- if PSJDD=""!($GET(PSGORQF))
- QUIT
- if PSJALLGS="A"
- SET PSJDGFLG=0
- DO EN^PSJGMRA(DFN,PSJDD)
- SET PSJDGFLG=1
- End DoDot:2
- End DoDot:1
- +36 KILL PSJXX,PSJYY,PSJDD,PSJCC,PSJALLGY,DACNT,PSJGGDN
- +37 QUIT
- DSPORD(ON,PSJNLST,PSJCLINF) ;Display the order data
- +1 ;ON - ON_U/V/P ex: 21V
- +2 ;PSJNLST - It's number list and also use to trigger pg break, line break
- +3 NEW PSJCOL,PSJX,PSJOC,PSJLINE,X
- +4 if ON=""
- QUIT
- +5 if '$DATA(PSJCLINF)
- SET PSJCLINF=";0"
- +6 SET PSJLINE=1
- SET PSJCOL=1
- +7 IF $PIECE(PSJCLINF,";",2)
- DO CLNDISP^PSJCLNOC(.PSJCLINF)
- Begin DoDot:1
- +8 IF $GET(PSJNLST)=""
- IF (($Y+6)>IOSL)
- DO PAUSE^PSJLMUT1
- WRITE @IOF
- End DoDot:1
- QUIT
- +9 IF ON'["V"
- DO DSPLORDU^PSJLMUT1(DFN,ON)
- +10 IF ON["V"
- DO DSPLORDV^PSJLMUT1(DFN,ON)
- +11 FOR PSJX=0:0
- SET PSJX=$ORDER(PSJOC(ON,PSJX))
- if 'PSJX
- QUIT
- Begin DoDot:1
- +12 IF $GET(PSJNLST)=""
- IF (($Y+6)>IOSL)
- DO PAUSE^PSJLMUT1
- WRITE @IOF
- +13 WRITE !
- +14 IF $GET(PSJNLST)
- if (PSJX=1)
- WRITE PSJNLST
- if (PSJX>1)
- WRITE ?$LENGTH(PSJNLST)
- +15 SET X=PSJOC(ON,PSJX)
- +16 WRITE $EXTRACT(X,9,$LENGTH(X))
- End DoDot:1
- +17 WRITE !
- +18 QUIT
- +19 ;
- DRUGERR ;Display drug level errors
- +1 NEW PSJPON,PSJN,PSJNV,PSJDSPFG,PSJPERR,PSJX,PSJLINEF
- +2 ;Only display the exceptions once per patient. Use the exception from prospective drug if exception(s) existed for the
- +3 ; same drug on the profile.
- +4 ;PSJEXCPT(PSJDNM_REASON) - Array for invalid drugs that already display to once within a pt selection
- +5 SET PSJDSPFG=0
- +6 SET PSJPERR=$$PROSPERR()
- +7 IF PSJPERR
- Begin DoDot:1
- +8 IF PSJDSPFG
- DO PAUSE^PSJLMUT1
- End DoDot:1
- QUIT
- +9 IF $DATA(PSJEXCPT("PROFILE"))
- IF '$GET(PSJDGCK)
- QUIT
- +10 SET PSJPON=""
- FOR
- SET PSJPON=$ORDER(^TMP($JOB,"PSJPRE","OUT","EXCEPTIONS",PSJPON))
- if PSJPON=""
- QUIT
- Begin DoDot:1
- +11 FOR PSJN=0:0
- SET PSJN=$ORDER(^TMP($JOB,"PSJPRE","OUT","EXCEPTIONS",PSJPON,PSJN))
- if 'PSJN
- QUIT
- Begin DoDot:2
- +12 IF '$GET(PSJLINEF)
- WRITE !
- SET PSJLINEF=1
- +13 SET PSJNV=$GET(^TMP($JOB,"PSJPRE","OUT","EXCEPTIONS",PSJPON,PSJN))
- +14 ;I ($P(PSJPON,";",3)="PROSPECTIVE") S PSJX='$$ERRCHK("PROSPECTIVE",$P(PSJNV,U,3)_$P(PSJNV,U,10))
- +15 IF ($PIECE(PSJPON,";",3)'="PROFILE")
- QUIT
- +16 IF '$$ERRCHK("PROFILE",$PIECE(PSJNV,U,3)_$PIECE(PSJNV,U,10))
- QUIT
- +17 DO DSPDRGER()
- End DoDot:2
- End DoDot:1
- +18 IF PSJDSPFG
- DO PAUSE^PSJLMUT1
- SET PSJDERR2=1
- +19 QUIT
- DSPDRGER(PSJDSFLG) ;
- +1 NEW PSJTXT
- +2 SET PSJTXT=$PIECE(PSJNV,U,7)
- +3 ;W:$G(PSGCOPY)!($G(PSIVCOPY)) !
- +4 SET X="Enhanced Order Checks cannot "
- +5 IF $GET(PSJDSFLG)
- IF (PSJTXT[X)
- SET PSJTXT="Dosing Checks could not "_$PIECE(PSJTXT,X,2)
- +6 SET PSJDSPFG=1
- +7 KILL PSJPAUSE
- +8 IF ($Y+6)>IOSL
- DO PAUSE^PSJLMUT1
- WRITE @IOF
- +9 WRITE !
- +10 DO WRITE^PSJMISC(PSJTXT,,79)
- +11 IF $PIECE(PSJNV,U,10)]""
- DO WRITE^PSJMISC("Reason(s): "_$PIECE(PSJNV,U,10),3,79)
- SET PSJDERF2=1
- +12 ;W !
- +13 QUIT
- ERRCHK(PSJTYPE,PSJX) ;
- +1 ;PSJTYPE - Either "PROFILE" or "PROSPECTIVE"
- +2 ;PSJX - Drug name_Error reason
- +3 ;Return 1 if this error drug has not displayed to the user.
- +4 IF $GET(PSJX)=""
- QUIT 0
- +5 IF $GET(PSJTYPE)=""
- QUIT 0
- +6 ;I PSJTYPE="PROFILE",'$D(PSJEXCPT(PSJTYPE,PSJX)) S PSJEXCPT(PSJTYPE,PSJX)="" Q 1
- +7 IF PSJTYPE="PROFILE"
- SET PSJEXCPT(PSJTYPE,PSJX)=""
- QUIT 1
- +8 IF PSJTYPE="PROSPECTIVE"
- IF '$DATA(PSJEXCPT(PSJTYPE,PSJX))
- SET PSJEXCPT(PSJTYPE,PSJX)=""
- QUIT 1
- +9 QUIT 0
- PING(PSJMSG) ;Check if FDB is down. Return 0 if it is
- +1 ;pass in a message to customize the display
- +2 SET ^TMP($JOB,"PSJPRE","IN","PING")=""
- +3 DO IN^PSSHRQ2("PSJPRE")
- +4 QUIT $$DSPSERR($GET(PSJMSG))
- DSPSERR(PSJMSG) ;Display system errors
- +1 NEW X
- +2 SET X=$GET(^TMP($JOB,"PSJPRE","OUT",0))
- +3 IF $PIECE(X,U)=-1
- DO NOFDB($PIECE(X,U,2),$GET(PSJMSG))
- +4 QUIT $SELECT($PIECE(X,U)=-1:0,1:1)
- NOFDB(PSJX,PSJMSG) ;Display connection down message
- +1 NEW X
- +2 if $GET(PSJX)=""
- QUIT
- +3 IF $GET(PSJMSG)]""
- WRITE !!,PSJMSG
- +4 IF $GET(PSJMSG)=""
- WRITE !!,"No Enhanced Order Checks can be performed."
- +5 WRITE !," Reason(s): ",PSJX,!!
- +6 KILL PSJX
- +7 if $GET(PSJMSG)]""
- DO PAUSE^PSJLMUT1
- +8 QUIT
- PROSPERR() ;Display exceptions for prospective drug
- +1 NEW PSJPON,PSJN,PSJNV,PSJPERR
- +2 ;If all prospectives are caught in the exception then display them only and omit the profile drugs
- +3 SET PSJPON=""
- FOR
- SET PSJPON=$ORDER(^TMP($JOB,"PSJPRE","OUT","EXCEPTIONS",PSJPON))
- if PSJPON=""
- QUIT
- Begin DoDot:1
- +4 FOR PSJN=0:0
- SET PSJN=$ORDER(^TMP($JOB,"PSJPRE","OUT","EXCEPTIONS",PSJPON,PSJN))
- if 'PSJN
- QUIT
- Begin DoDot:2
- +5 SET PSJNV=$GET(^TMP($JOB,"PSJPRE","OUT","EXCEPTIONS",PSJPON,PSJN))
- +6 IF $PIECE(PSJPON,";",3)="PROFILE"
- QUIT
- +7 IF ($PIECE(PSJPON,";",3)="PROSPECTIVE")
- SET PSJX='$$ERRCHK("PROSPECTIVE",$PIECE(PSJNV,U,3)_$PIECE(PSJNV,U,10))
- +8 DO DSPDRGER()
- SET PSJDSPFG=1
- End DoDot:2
- End DoDot:1
- +9 ;If the prospective drug(s) is caught in the exception, the exception for profile drug(s) is not display.
- +10 ; The exception for the prospective is the only one need to display.
- +11 SET PSJPERR=1
- +12 SET PSJPON=""
- FOR
- SET PSJPON=$ORDER(^TMP($JOB,"PSJPRE","IN","PROSPECTIVE",PSJPON))
- if PSJPON=""
- QUIT
- Begin DoDot:1
- +13 IF $DATA(^TMP($JOB,"PSJPRE","OUT","EXCEPTIONS",PSJPON))
- QUIT
- +14 SET (PSJDSPFG,PSJPERR)=0
- End DoDot:1
- +15 QUIT PSJPERR
- +16 ;
- HAZCHK ;Check for a hazardous drug component and display soft error type warning roll and scroll alert *364
- +1 NEW PSORDN,HDG,HAZ,HAZH,HAZD,HZAR,HTXT,LL,DRGIEN,TOP
- +2 SET (HAZH,HAZD)=0
- +3 ;Unit Dose
- IF $GET(ON)
- IF '$GET(PSGDRG)
- IF (($GET(NAME)["PSJ LM UD")!($GET(NAME)["PSJU LM")!($GET(NAME)["PSJ LM PENDING"))
- Begin DoDot:1
- +4 IF $GET(PSGORD)["P"
- SET PSORDN="^PS(53.1,"_+PSGORD_","
- +5 IF '$GET(PSGORD)
- IF ON["P"
- SET PSORDN="^PS(53.1,"_+ON_","
- +6 IF $GET(PSGORD)
- IF ON["U"
- SET PSORDN="^PS(55,"_DFN_",5,"_+ON_","
- +7 if '$DATA(PSORDN)
- QUIT
- +8 DO HAZDRUG(PSORDN,.HZAR)
- End DoDot:1
- +9 ;IV new dispense only
- IF '$DATA(PSJALLGY)
- IF $GET(PSGDRG)
- IF $GET(NAME)'["PSJ LM IV"
- Begin DoDot:1
- +10 SET HZAR(PSGDRG)=$$HAZ^PSSUTIL(PSGDRG)
- End DoDot:1
- +11 ;IV pending or edit
- IF '$DATA(PSJALLGY)
- IF $GET(PSJORD)
- IF $GET(NAME)["PSJ LM IV"
- Begin DoDot:1
- +12 if PSJORD["P"
- SET PSORDN="^PS(53.1,"_+PSJORD_","
- +13 if PSJORD["V"
- SET PSORDN="^PS(55,"_DFN_",""IV"","_+PSJORD_","
- +14 if '$DATA(PSORDN)
- QUIT
- +15 DO HAZDRUG(PSORDN,.HZAR)
- End DoDot:1
- +16 ;IV new order add mix
- IF $DATA(PSJALLGY)
- FOR DRGIEN=0:0
- SET DRGIEN=$ORDER(PSJALLGY(DRGIEN))
- if 'DRGIEN
- QUIT
- Begin DoDot:1
- +17 SET HZAR(DRGIEN)=$$HAZ^PSSUTIL(DRGIEN)
- End DoDot:1
- +18 ;display warning text(s)
- +19 SET HAZ=0
- SET HDG=1
- SET $PIECE(LL,"-",80)="-"
- +20 FOR DRGIEN=0:0
- SET DRGIEN=$ORDER(HZAR(DRGIEN))
- if 'DRGIEN
- QUIT
- Begin DoDot:1
- +21 SET HAZH=$PIECE(HZAR(DRGIEN),U)
- SET HAZD=$PIECE(HZAR(DRGIEN),U,2)
- +22 if '(HAZH!HAZD)!('$DATA(DRGIEN))
- QUIT
- +23 DO HAZWARNG^PSSUTIL(DRGIEN,"I",HAZH,HAZD,.HTXT)
- SET HAZ=1
- +24 ;header
- IF HDG
- WRITE #,$CHAR(7),LL,!,$JUSTIFY("***** WARNING *****",47)
- SET HDG=0
- +25 ;body
- DO WRAPTEXT(HTXT,65,5)
- WRITE !
- End DoDot:1
- +26 ;footer
- if HAZ
- Begin DoDot:1
- +27 WRITE LL,!
- +28 KILL DIR
- SET DIR(0)="E"
- SET DIR("?")="Press Return to continue"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- End DoDot:1
- +29 QUIT
- +30 ;
- HAZDRUG(FILE,AR) ;Get Hazardous to Handle and Hazardous to Dispose fields per component and return Haz array by DRUG IEN *364
- +1 ; FILE = file root + Order Num from inpatient variables during workflow; Example VAR contains: "^PS(55,DFN,5,ON," or "(PS(53.1,ON," or "^PS(55,DFN,"IV",ON,"
- +2 ; (build ROOT to the multiple level to find all Disp Drugs or Additives or Solution and get HAZ flags)
- +3 ; AR = array of component's IEN and their Haz flag settings
- +4 NEW QQ,ROOT,NXTROOT,NXT,IFN,GL
- +5 ;check IF Unit Dose Disp Drug exists for this order, then get IEN(s) and Haz flags
- +6 IF FILE[",5,"
- FOR QQ=0:0
- SET ROOT=FILE_"1,"_QQ_")"
- SET QQ=$ORDER(@ROOT)
- if 'QQ
- QUIT
- Begin DoDot:1
- +7 SET NXTROOT=FILE_"1,"_QQ_")"
- SET NXT=$ORDER(@NXTROOT)
- SET GL=$EXTRACT(NXTROOT,1,$LENGTH(ROOT)-1)
- SET IFN=+@(GL_",0)")
- +8 SET AR(IFN)=$$HAZ^PSSUTIL(IFN)
- +9 ;check IF IV additives exist for this order, then get IEN(s) and Haz flags
- End DoDot:1
- +10 IF FILE[",""IV"","
- FOR QQ=0:0
- SET ROOT=FILE_"""AD"","_QQ_")"
- SET QQ=$ORDER(@ROOT)
- if 'QQ
- QUIT
- Begin DoDot:1
- +11 SET NXTROOT=FILE_"""AD"","_QQ_")"
- SET NXT=$ORDER(@NXTROOT)
- SET GL=$EXTRACT(NXTROOT,1,$LENGTH(ROOT)-1)
- SET IFN=+@(GL_",0)")
- +12 IF IFN
- SET IFN=+$PIECE($GET(^PS(52.6,IFN,0)),U,2)
- SET AR(IFN)=$$HAZ^PSSUTIL(IFN)
- +13 ;check IF IV solutions exist for this order, then get IEN(s) and Haz flags
- End DoDot:1
- +14 IF FILE[",""IV"","
- FOR QQ=0:0
- SET ROOT=FILE_"""SOL"","_QQ_")"
- SET QQ=$ORDER(@ROOT)
- if 'QQ
- QUIT
- Begin DoDot:1
- +15 SET NXTROOT=FILE_"""SOL"","_QQ_")"
- SET NXT=$ORDER(@NXTROOT)
- SET GL=$EXTRACT(NXTROOT,1,$LENGTH(ROOT)-1)
- SET IFN=+@(GL_",0)")
- +16 IF IFN
- SET IFN=+$PIECE($GET(^PS(52.7,IFN,0)),U,2)
- SET AR(IFN)=$$HAZ^PSSUTIL(IFN)
- End DoDot:1
- +17 QUIT
- +18 ;
- WRAPTEXT(TEXT,LIMIT,CSPACES) ;Wrap text util copied in from a PSO routine originally *364
- +1 ;;FUNCTION TO DISPLAY (WRITE) TEXT WRAPPED TO A CERTAIN COLUMN LENGTH
- +2 ;;DEFAULT=74 CHARACTERS WITH NO SPACES IN FRONT
- +3 NEW WORDS,COUNT,LINE,NEXTWORD
- +4 if $GET(TEXT)']""
- QUIT ""
- +5 SET LIMIT=$GET(LIMIT,74)
- +6 SET CSPACES=$SELECT($GET(CSPACES):CSPACES,1:0)
- +7 SET WORDS=$LENGTH(TEXT," ")
- +8 WRITE !,$$REPEAT^XLFSTR(" ",CSPACES)
- +9 FOR COUNT=1:1:WORDS
- Begin DoDot:1
- +10 SET NEXTWORD=$PIECE(TEXT," ",COUNT)
- +11 ;TO REMOVE LEADING OR DOUBLE SPACES
- if NEXTWORD=""
- QUIT
- +12 SET LINE=$GET(LINE)_NEXTWORD_" "
- +13 IF $LENGTH($GET(LINE))>LIMIT
- WRITE !,$$REPEAT^XLFSTR(" ",CSPACES)
- KILL LINE
- +14 WRITE NEXTWORD_" "
- End DoDot:1
- +15 QUIT