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 Dec 13, 2024@02:07:58 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
