PSOHLDS3 ;BHAM ISC/SAB,LC,PWC - BUILD PROFILE FOR AUTOMATED INTERFACE ;4/13/05 1:53pm
;;7.0;OUTPATIENT PHARMACY;**156,198**;DEC 1997
;reference to PSDRUG suppoprted by DBIA # 221
;reference to PS(50.606 supported by DBIA # 2174
;reference to PS(50.7 supported by DBIA #2223
;reference to PS(55 supported by DBIA # 2228
;reference to PS(56 supported by DBIA # 2229
;
;PSO*198 add check to insert spaces into PMI segments, also add
; "NTE|6||" to beginning of NTE6 segment
;
START ;build profile for the NTE4 segment
Q:'$D(DFN)
N II K ^TMP($J,"PRF")
S PSODFN=DFN I '$D(PSODTCUT) D CUTDATE^PSOFUNC
S:'$D(Z) Z=1 S:'$D(NEW1) (NEW1,NEW11)="^" S %DT="",X="T" D ^%DT S DT1=Y S X1=DT1,X2=-365 D C^%DTC S EXPS=X S X1=DT1,X2=-182 D C^%DTC S EXP=X
F RXX=0:0 S RXX=$O(^PS(55,DFN,"P",RXX)) Q:'RXX S RXNN=+^(RXX,0) I $D(^PSRX(RXNN,0)),$P($G(^("STA")),"^")'=13 S RXPX=^PSRX(RXNN,0),$P(RXPX,"^",15)=$P($G(^("STA")),"^"),RXPX2=^(2) D CHK
I '$D(^TMP($J,"PRF")) G PPP
;
SD S CNT=1 F SD="A","C","S" I $D(^TMP($J,"PRF",SD)) S DRNME="" D DRNME
PPP D PEND
K ^TMP($J,"PRF")
K A,B,DRNME,DRP,EXP,EXPS,I,II,ISSD,J,LINE,LN,MESS,MJK,NEW1,NEW11,PHYS,POP,PQTY,TTTT,RFL,RFS,RXF,RXNN,RXPX,RXPX2,RXPNO,RXX
K SD,SIG,STA,X,X1,X2,Y,Z,CNT,PEND,PSODTCUT,PSOPRPAS,PZZODRUG,RFDATE
Q
DRNME S DRNME=$O(^TMP($J,"PRF",SD,DRNME)) Q:DRNME="" D ISSD G DRNME
;
ISSD F ISSD=0:0 S ISSD=$O(^TMP($J,"PRF",SD,DRNME,ISSD)) Q:'ISSD S RXPNO="" D RXPNO
Q
RXPNO S RXPNO=$O(^TMP($J,"PRF",SD,DRNME,ISSD,RXPNO)) Q:RXPNO="" S RXNN=^(RXPNO) I $D(^PSRX(RXNN,0)) S RXPX=^(0),RXPX2=^(2) D PRT G RXPNO
;
CHK Q:PSODTCUT>$P(RXPX2,"^",6)
I $P(^PSRX(RXNN,"STA"),"^")=12 S II=RXNN D LAST^PSORFL Q:PSODTCUT>RFDATE
I $P(RXPX,"^",3)=7!($P(RXPX,"^",3)=8)&('PSOPRPAS) Q
S J="^"_RXNN_"^" Q:(NEW1[J)!(NEW11[J) Q:$P(RXPX,"^",13)<EXPS S RXPNO=$P(RXPX,"^"),ISSD=$P(RXPX,"^",13)
Q:'$D(^PSDRUG($P(RXPX,"^",6),0)) S DRP=^(0),SD=$S($P(DRP,"^",3)["S":"S",$P(RXPX,"^",15)=12:"C",1:"A"),DRNME=$P(DRP,"^"),^TMP($J,"PRF",SD,DRNME,ISSD,RXPNO)=RXNN
Q
PRT S RFS=$P(RXPX,"^",9),PQTY=$P(RXPX,"^",7)
K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=$P(RXPX,"^",4) D ^DIC
S PHYS=$S(+Y:$P(Y,"^",2),1:"UNKNOWN"),II=RXNN D LAST^PSORFL S RXF=0 F MJK=0:0 S MJK=$O(^PSRX(RXNN,1,MJK)) Q:'MJK S RXF=RXF+1
S STA=$S($P(^PSRX(RXNN,"STA"),"^")=14:"DC",$P(^PSRX(RXNN,"STA"),"^")=15:"DE",$P(^PSRX(RXNN,"STA"),"^")=16:"PH",1:$E("ANRHPS ECD",(1+$P(^PSRX(RXNN,"STA"),"^")))),STA=$S(DT1>$P(RXPX2,"^",6):"E",1:STA)
D SIG S FSIG=$O(FSIG(""),-1)
S ^TMP("PSO",$J,PSI)="NTE"_FS_4_FS_FS,NTE4=1
S ^TMP("PSO",$J,PSI,CNT)=SD_CS_RXPNO_CS_DRNME_CS_$E(ISSD,4,5)_"/"_$E(ISSD,6,7)
S ^TMP("PSO",$J,PSI,CNT)=^TMP("PSO",$J,PSI,CNT)_CS_$E(RFL,1,5)_CS_RFS_CS_RXF_CS_PQTY_CS_STA_CS_$E(PHYS,1,20)_CS_$S($G(FSIG)'="":FSIG,1:"""""")_FS_"Profile Information"
S CNT=CNT+1
Q
SIG ;Format Sig
S PSPROSIG=$P($G(^PSRX(RXNN,"SIG")),"^",2) K FSIG,BSIG D
.I PSPROSIG D FSIG^PSOUTLA("R",RXNN,80) Q
.D EN2^PSOUTLA1(RXNN,80) F GGGGG=0:0 S GGGGG=$O(BSIG(GGGGG)) Q:'GGGGG S FSIG(GGGGG)=BSIG(GGGGG)
K PSPROSIG,GGGGG,BSIG Q
PEND ;include pending orders in profile
N PSPCOUNT,PSPPEND,ZXXX,PSPSTAT,FSIGZZ,PZZDRUG,PSSODRUG,PZXZERO,PPPPP,GGGGG
S PSPCOUNT=1,PSPPEND="" F PPPPP=0:0 S PPPPP=$O(^PS(52.41,"P",DFN,PPPPP)) Q:'PPPPP S PSPSTAT=$P($G(^PS(52.41,PPPPP,0)),"^",3) I PSPSTAT="NW"!(PSPSTAT="HD")!(PSPSTAT="RNW") S PSPPEND(PSPCOUNT)=PPPPP,PSPCOUNT=PSPCOUNT+1
Q:'$O(PSPPEND(0))
F ZXXX=0:0 S ZXXX=$O(PSPPEND(ZXXX)) Q:'ZXXX S PZXZERO=$G(^PS(52.41,PSPPEND(ZXXX),0)) D:$P(PZXZERO,"^")
.S PZZDRUG=$P(PZXZERO,"^",9),PZZODRUG=$P(PZXZERO,"^",8) Q:'PZZDRUG Q:'PZZODRUG
.S PEND="P"_CS_$S(PZZDRUG:$P($G(^PSDRUG(+PZZDRUG,0)),"^"),1:$P($G(^PS(50.7,+PZZODRUG,0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^"))
.S PEND=PEND_CS_$E($P(PZXZERO,"^",6),4,5)_"/"_$E($P(PZXZERO,"^",6),6,7)_"/"_$E($P(PZXZERO,"^",6),2,3)
. K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=+$P(PZXZERO,"^",5) D ^DIC
.S PEND=PEND_CS_$P(PZXZERO,"^",10)_CS_$P(PZXZERO,"^",11)_CS_$S(+Y:$P(Y,"^",2),1:"")
.D FSIG^PSOUTLA("P",PSPPEND(ZXXX),100) S PEND=PEND_CS_$G(FSIG(1)) F FSIGZZ=1:0 S FSIGZZ=$O(FSIG(FSIGZZ)) Q:'FSIGZZ S PEND=PEND_CS_$G(FSIG(FSIGZZ))
S:$D(PEND) ^TMP("PSO",$J,PSI,CNT)=PEND
S CNT=CNT+1
Q
;
START2 ;build NTE for drug interactions
K PSOSERV
S RX=IRXN,RXY=^PSRX(RX,0)
I $D(^PS(52.4,RX,0)) S SCRIPT=$P(^PS(52.4,RX,0),"^",10),SEV=$P(^PS(52.4,RX,0),"^",9) F X=1:1 S RXX(X)=$P(SCRIPT,",",X),SEV(X)=$P(SEV,",",X) Q:RXX(X)="" D
.S SER=$P(^PS(56,SEV(X),0),"^",4) S:$G(SER)=1 PSOSERV=1
.S DIRX=$P($G(^PSRX(RXX(X),0)),"^"),TYP=$S(SER=1:"CRITICAL",SER=2:"SIGNIFICANT",1:"UNKNOWN")
.S DRG=$P(^PSDRUG($P(^PSRX(RXX(X),0),"^",6),0),"^")
.S:X=1 NTE5=DIRX_CS_TYP_CS_DRG
.S:X>1 NTE5=RS_DIRX_CS_TYP_CS_DRG
I '$D(^PS(52.4,RX,0)),$D(^PSRX(RX,"DRI")) S SCRIPT=$P(^PSRX(RX,"DRI"),"^",2),SEV=$P(^PSRX(RX,"DRI"),"^") F X=1:1 S RXX(X)=$P(SCRIPT,",",X),SEV(X)=$P(SEV,",",X) Q:RXX(X)="" D
.S SER=$P(^PS(56,SEV(X),0),"^",4)
.S DIRX=$P($G(^PSRX(RXX(X),0)),"^"),TYP=$S(SER=1:"CRITICAL",SER=2:"SIGNIFICANT",1:"UNKNOWN")
.S DRG=$P(^PSDRUG($P(^PSRX(RXX(X),0),"^",6),0),"^")
.S:X=1 NTE5=DIRX_CS_TYP_CS_DRG
.S:X>1 NTE5=RS_DIRX_CS_TYP_CS_DRG
S NTE5=NTE5_CS_$S('$G(PSOSERV):"MAY REQUIRE",1:"REQUIRES")_$S('$G(PSOSERV):" REVIEWING BY A PHARMACIST",1:" INTERVENTION BY A PHARMACIST")
K SER,SCRIPT,DIRX,TYP,DRG,SEV,RXX,RX,RXY
Q
START3 ;build NTE for drug allergy warning label ;PSO*198
Q:'$G(DAW)
S NTE6="NTE"_FS_6_FS_FS
I '$G(DIN) D
. S DARX=$P(^PSRX(IRXN,0),"^"),DRG=$P(^PSDRUG(IDGN,0),"^")
. S NTE6=NTE6_DARX_CS_DRG
I $G(DIN) D
. S DARX=$P(^PSRX(IRXN,0),"^"),DRG=$P(^PSDRUG(IDGN,0),"^") D
. . S NTE6=NTE6_DARX_CS_DRG
. . F XY=1:1 S INGRE=ING(XY) S:XY=1 NTE6=NTE6_CS_INGRE S:XY>1 NTE6=NTE6_RS_INGRE Q:'INGRE
K DARX,DRG,XY,INGRE
Q
;PSO*198
SPACE(PLN,CLN) ;check if a space should be inserted between lines of text
; Input: PLN - previous line of text
; CLN - current line of text to be appended to previous
; function return: 0 - do not insert space
; 1 - insert space
;
;quit 0, on cases where a space should NOT be inserted else assume 1
;
N TSTP,TSTC,PCHR2,CCHR2 ; QUIT 0 CASES BELOW
Q:PLN="" 0 ;no previous line, ignore
Q:$E(PLN,$L(PLN))=" " 0 ;prev line ends in " "
Q:$E(CLN,1)=" " 0 ;curr line begins in " "
S PCHR2=$E(PLN,$L(PLN)-1,$L(PLN)) ;last 2 char of prev line
S CCHR2=$E(CLN,1,2) ;first 2 char of curr line
Q:PCHR2?1A1"/" 0 ;the prev & curr lines
Q:CCHR2?1"/"1A 0 ; split, ex: "and/or"
Q:PCHR2?1A1"-" 0 ;the prev & curr lines
Q:CCHR2?1"-"1A 0 ; split ex: "15-25 degrees"
S TSTP=$TR(PCHR2,"abcdefghijklmnoqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
S TSTC=$TR(CCHR2,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
S TSTP=TSTP_TSTC
Q:TSTP="E.G." 0 ;lines are splitting "e.g."
Q:TSTP="I.E." 0 ;lines are splitting "i.e."
;
Q 1
PSOHLDS3 ;BHAM ISC/SAB,LC,PWC - BUILD PROFILE FOR AUTOMATED INTERFACE ;4/13/05 1:53pm
+1 ;;7.0;OUTPATIENT PHARMACY;**156,198**;DEC 1997
+2 ;reference to PSDRUG suppoprted by DBIA # 221
+3 ;reference to PS(50.606 supported by DBIA # 2174
+4 ;reference to PS(50.7 supported by DBIA #2223
+5 ;reference to PS(55 supported by DBIA # 2228
+6 ;reference to PS(56 supported by DBIA # 2229
+7 ;
+8 ;PSO*198 add check to insert spaces into PMI segments, also add
+9 ; "NTE|6||" to beginning of NTE6 segment
+10 ;
START ;build profile for the NTE4 segment
+1 IF '$DATA(DFN)
QUIT
+2 NEW II
KILL ^TMP($JOB,"PRF")
+3 SET PSODFN=DFN
IF '$DATA(PSODTCUT)
DO CUTDATE^PSOFUNC
+4 IF '$DATA(Z)
SET Z=1
IF '$DATA(NEW1)
SET (NEW1,NEW11)="^"
SET %DT=""
SET X="T"
DO ^%DT
SET DT1=Y
SET X1=DT1
SET X2=-365
DO C^%DTC
SET EXPS=X
SET X1=DT1
SET X2=-182
DO C^%DTC
SET EXP=X
+5 FOR RXX=0:0
SET RXX=$ORDER(^PS(55,DFN,"P",RXX))
IF 'RXX
QUIT
SET RXNN=+^(RXX,0)
IF $DATA(^PSRX(RXNN,0))
IF $PIECE($GET(^("STA")),"^")'=13
SET RXPX=^PSRX(RXNN,0)
SET $PIECE(RXPX,"^",15)=$PIECE($GET(^("STA")),"^")
SET RXPX2=^(2)
DO CHK
+6 IF '$DATA(^TMP($JOB,"PRF"))
GOTO PPP
+7 ;
SD SET CNT=1
FOR SD="A","C","S"
IF $DATA(^TMP($JOB,"PRF",SD))
SET DRNME=""
DO DRNME
PPP DO PEND
+1 KILL ^TMP($JOB,"PRF")
+2 KILL A,B,DRNME,DRP,EXP,EXPS,I,II,ISSD,J,LINE,LN,MESS,MJK,NEW1,NEW11,PHYS,POP,PQTY,TTTT,RFL,RFS,RXF,RXNN,RXPX,RXPX2,RXPNO,RXX
+3 KILL SD,SIG,STA,X,X1,X2,Y,Z,CNT,PEND,PSODTCUT,PSOPRPAS,PZZODRUG,RFDATE
+4 QUIT
DRNME SET DRNME=$ORDER(^TMP($JOB,"PRF",SD,DRNME))
IF DRNME=""
QUIT
DO ISSD
GOTO DRNME
+1 ;
ISSD FOR ISSD=0:0
SET ISSD=$ORDER(^TMP($JOB,"PRF",SD,DRNME,ISSD))
IF 'ISSD
QUIT
SET RXPNO=""
DO RXPNO
+1 QUIT
RXPNO SET RXPNO=$ORDER(^TMP($JOB,"PRF",SD,DRNME,ISSD,RXPNO))
IF RXPNO=""
QUIT
SET RXNN=^(RXPNO)
IF $DATA(^PSRX(RXNN,0))
SET RXPX=^(0)
SET RXPX2=^(2)
DO PRT
GOTO RXPNO
+1 ;
CHK IF PSODTCUT>$PIECE(RXPX2,"^",6)
QUIT
+1 IF $PIECE(^PSRX(RXNN,"STA"),"^")=12
SET II=RXNN
DO LAST^PSORFL
IF PSODTCUT>RFDATE
QUIT
+2 IF $PIECE(RXPX,"^",3)=7!($PIECE(RXPX,"^",3)=8)&('PSOPRPAS)
QUIT
+3 SET J="^"_RXNN_"^"
IF (NEW1[J)!(NEW11[J)
QUIT
IF $PIECE(RXPX,"^",13)<EXPS
QUIT
SET RXPNO=$PIECE(RXPX,"^")
SET ISSD=$PIECE(RXPX,"^",13)
+4 IF '$DATA(^PSDRUG($PIECE(RXPX,"^",6),0))
QUIT
SET DRP=^(0)
SET SD=$SELECT($PIECE(DRP,"^",3)["S":"S",$PIECE(RXPX,"^",15)=12:"C",1:"A")
SET DRNME=$PIECE(DRP,"^")
SET ^TMP($JOB,"PRF",SD,DRNME,ISSD,RXPNO)=RXNN
+5 QUIT
PRT SET RFS=$PIECE(RXPX,"^",9)
SET PQTY=$PIECE(RXPX,"^",7)
+1 KILL DIC,X,Y
SET DIC="^VA(200,"
SET DIC(0)="N,Z"
SET X=$PIECE(RXPX,"^",4)
DO ^DIC
+2 SET PHYS=$SELECT(+Y:$PIECE(Y,"^",2),1:"UNKNOWN")
SET II=RXNN
DO LAST^PSORFL
SET RXF=0
FOR MJK=0:0
SET MJK=$ORDER(^PSRX(RXNN,1,MJK))
IF 'MJK
QUIT
SET RXF=RXF+1
+3 SET STA=$SELECT($PIECE(^PSRX(RXNN,"STA"),"^")=14:"DC",$PIECE(^PSRX(RXNN,"STA"),"^")=15:"DE",$PIECE(^PSRX(RXNN,"STA"),"^")=16:"PH",1:$EXTRACT("ANRHPS ECD",(1+$PIECE(^PSRX(RXNN,"STA"),"^"))))
SET STA=$SELECT(DT1>$PIECE(RXPX2,"^",6):"E",1:STA)
+4 DO SIG
SET FSIG=$ORDER(FSIG(""),-1)
+5 SET ^TMP("PSO",$JOB,PSI)="NTE"_FS_4_FS_FS
SET NTE4=1
+6 SET ^TMP("PSO",$JOB,PSI,CNT)=SD_CS_RXPNO_CS_DRNME_CS_$EXTRACT(ISSD,4,5)_"/"_$EXTRACT(ISSD,6,7)
+7 SET ^TMP("PSO",$JOB,PSI,CNT)=^TMP("PSO",$JOB,PSI,CNT)_CS_$EXTRACT(RFL,1,5)_CS_RFS_CS_RXF_CS_PQTY_CS_STA_CS_$EXTRACT(PHYS,1,20)_CS_$SELECT($GET(FSIG)'="":FSIG,1:"""""")_FS_"Profile Information"
+8 SET CNT=CNT+1
+9 QUIT
SIG ;Format Sig
+1 SET PSPROSIG=$PIECE($GET(^PSRX(RXNN,"SIG")),"^",2)
KILL FSIG,BSIG
Begin DoDot:1
+2 IF PSPROSIG
DO FSIG^PSOUTLA("R",RXNN,80)
QUIT
+3 DO EN2^PSOUTLA1(RXNN,80)
FOR GGGGG=0:0
SET GGGGG=$ORDER(BSIG(GGGGG))
IF 'GGGGG
QUIT
SET FSIG(GGGGG)=BSIG(GGGGG)
End DoDot:1
+4 KILL PSPROSIG,GGGGG,BSIG
QUIT
PEND ;include pending orders in profile
+1 NEW PSPCOUNT,PSPPEND,ZXXX,PSPSTAT,FSIGZZ,PZZDRUG,PSSODRUG,PZXZERO,PPPPP,GGGGG
+2 SET PSPCOUNT=1
SET PSPPEND=""
FOR PPPPP=0:0
SET PPPPP=$ORDER(^PS(52.41,"P",DFN,PPPPP))
IF 'PPPPP
QUIT
SET PSPSTAT=$PIECE($GET(^PS(52.41,PPPPP,0)),"^",3)
IF PSPSTAT="NW"!(PSPSTAT="HD")!(PSPSTAT="RNW")
SET PSPPEND(PSPCOUNT)=PPPPP
SET PSPCOUNT=PSPCOUNT+1
+3 IF '$ORDER(PSPPEND(0))
QUIT
+4 FOR ZXXX=0:0
SET ZXXX=$ORDER(PSPPEND(ZXXX))
IF 'ZXXX
QUIT
SET PZXZERO=$GET(^PS(52.41,PSPPEND(ZXXX),0))
IF $PIECE(PZXZERO,"^")
Begin DoDot:1
+5 SET PZZDRUG=$PIECE(PZXZERO,"^",9)
SET PZZODRUG=$PIECE(PZXZERO,"^",8)
IF 'PZZDRUG
QUIT
IF 'PZZODRUG
QUIT
+6 SET PEND="P"_CS_$SELECT(PZZDRUG:$PIECE($GET(^PSDRUG(+PZZDRUG,0)),"^"),1:$PIECE($GET(^PS(50.7,+PZZODRUG,0)),"^")_" "_$PIECE($GET(^PS(50.606,+$PIECE($GET(^(0)),"^",2),0)),"^"))
+7 SET PEND=PEND_CS_$EXTRACT($PIECE(PZXZERO,"^",6),4,5)_"/"_$EXTRACT($PIECE(PZXZERO,"^",6),6,7)_"/"_$EXTRACT($PIECE(PZXZERO,"^",6),2,3)
+8 KILL DIC,X,Y
SET DIC="^VA(200,"
SET DIC(0)="N,Z"
SET X=+$PIECE(PZXZERO,"^",5)
DO ^DIC
+9 SET PEND=PEND_CS_$PIECE(PZXZERO,"^",10)_CS_$PIECE(PZXZERO,"^",11)_CS_$SELECT(+Y:$PIECE(Y,"^",2),1:"")
+10 DO FSIG^PSOUTLA("P",PSPPEND(ZXXX),100)
SET PEND=PEND_CS_$GET(FSIG(1))
FOR FSIGZZ=1:0
SET FSIGZZ=$ORDER(FSIG(FSIGZZ))
IF 'FSIGZZ
QUIT
SET PEND=PEND_CS_$GET(FSIG(FSIGZZ))
End DoDot:1
+11 IF $DATA(PEND)
SET ^TMP("PSO",$JOB,PSI,CNT)=PEND
+12 SET CNT=CNT+1
+13 QUIT
+14 ;
START2 ;build NTE for drug interactions
+1 KILL PSOSERV
+2 SET RX=IRXN
SET RXY=^PSRX(RX,0)
+3 IF $DATA(^PS(52.4,RX,0))
SET SCRIPT=$PIECE(^PS(52.4,RX,0),"^",10)
SET SEV=$PIECE(^PS(52.4,RX,0),"^",9)
FOR X=1:1
SET RXX(X)=$PIECE(SCRIPT,",",X)
SET SEV(X)=$PIECE(SEV,",",X)
IF RXX(X)=""
QUIT
Begin DoDot:1
+4 SET SER=$PIECE(^PS(56,SEV(X),0),"^",4)
IF $GET(SER)=1
SET PSOSERV=1
+5 SET DIRX=$PIECE($GET(^PSRX(RXX(X),0)),"^")
SET TYP=$SELECT(SER=1:"CRITICAL",SER=2:"SIGNIFICANT",1:"UNKNOWN")
+6 SET DRG=$PIECE(^PSDRUG($PIECE(^PSRX(RXX(X),0),"^",6),0),"^")
+7 IF X=1
SET NTE5=DIRX_CS_TYP_CS_DRG
+8 IF X>1
SET NTE5=RS_DIRX_CS_TYP_CS_DRG
End DoDot:1
+9 IF '$DATA(^PS(52.4,RX,0))
IF $DATA(^PSRX(RX,"DRI"))
SET SCRIPT=$PIECE(^PSRX(RX,"DRI"),"^",2)
SET SEV=$PIECE(^PSRX(RX,"DRI"),"^")
FOR X=1:1
SET RXX(X)=$PIECE(SCRIPT,",",X)
SET SEV(X)=$PIECE(SEV,",",X)
IF RXX(X)=""
QUIT
Begin DoDot:1
+10 SET SER=$PIECE(^PS(56,SEV(X),0),"^",4)
+11 SET DIRX=$PIECE($GET(^PSRX(RXX(X),0)),"^")
SET TYP=$SELECT(SER=1:"CRITICAL",SER=2:"SIGNIFICANT",1:"UNKNOWN")
+12 SET DRG=$PIECE(^PSDRUG($PIECE(^PSRX(RXX(X),0),"^",6),0),"^")
+13 IF X=1
SET NTE5=DIRX_CS_TYP_CS_DRG
+14 IF X>1
SET NTE5=RS_DIRX_CS_TYP_CS_DRG
End DoDot:1
+15 SET NTE5=NTE5_CS_$SELECT('$GET(PSOSERV):"MAY REQUIRE",1:"REQUIRES")_$SELECT('$GET(PSOSERV):" REVIEWING BY A PHARMACIST",1:" INTERVENTION BY A PHARMACIST")
+16 KILL SER,SCRIPT,DIRX,TYP,DRG,SEV,RXX,RX,RXY
+17 QUIT
START3 ;build NTE for drug allergy warning label ;PSO*198
+1 IF '$GET(DAW)
QUIT
+2 SET NTE6="NTE"_FS_6_FS_FS
+3 IF '$GET(DIN)
Begin DoDot:1
+4 SET DARX=$PIECE(^PSRX(IRXN,0),"^")
SET DRG=$PIECE(^PSDRUG(IDGN,0),"^")
+5 SET NTE6=NTE6_DARX_CS_DRG
End DoDot:1
+6 IF $GET(DIN)
Begin DoDot:1
+7 SET DARX=$PIECE(^PSRX(IRXN,0),"^")
SET DRG=$PIECE(^PSDRUG(IDGN,0),"^")
Begin DoDot:2
+8 SET NTE6=NTE6_DARX_CS_DRG
+9 FOR XY=1:1
SET INGRE=ING(XY)
IF XY=1
SET NTE6=NTE6_CS_INGRE
IF XY>1
SET NTE6=NTE6_RS_INGRE
IF 'INGRE
QUIT
End DoDot:2
End DoDot:1
+10 KILL DARX,DRG,XY,INGRE
+11 QUIT
+12 ;PSO*198
SPACE(PLN,CLN) ;check if a space should be inserted between lines of text
+1 ; Input: PLN - previous line of text
+2 ; CLN - current line of text to be appended to previous
+3 ; function return: 0 - do not insert space
+4 ; 1 - insert space
+5 ;
+6 ;quit 0, on cases where a space should NOT be inserted else assume 1
+7 ;
+8 ; QUIT 0 CASES BELOW
NEW TSTP,TSTC,PCHR2,CCHR2
+9 ;no previous line, ignore
IF PLN=""
QUIT 0
+10 ;prev line ends in " "
IF $EXTRACT(PLN,$LENGTH(PLN))=" "
QUIT 0
+11 ;curr line begins in " "
IF $EXTRACT(CLN,1)=" "
QUIT 0
+12 ;last 2 char of prev line
SET PCHR2=$EXTRACT(PLN,$LENGTH(PLN)-1,$LENGTH(PLN))
+13 ;first 2 char of curr line
SET CCHR2=$EXTRACT(CLN,1,2)
+14 ;the prev & curr lines
IF PCHR2?1A1"/"
QUIT 0
+15 ; split, ex: "and/or"
IF CCHR2?1"/"1A
QUIT 0
+16 ;the prev & curr lines
IF PCHR2?1A1"-"
QUIT 0
+17 ; split ex: "15-25 degrees"
IF CCHR2?1"-"1A
QUIT 0
+18 SET TSTP=$TRANSLATE(PCHR2,"abcdefghijklmnoqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+19 SET TSTC=$TRANSLATE(CCHR2,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+20 SET TSTP=TSTP_TSTC
+21 ;lines are splitting "e.g."
IF TSTP="E.G."
QUIT 0
+22 ;lines are splitting "i.e."
IF TSTP="I.E."
QUIT 0
+23 ;
+24 QUIT 1
