PSOHLNEW.m

PSOHLNEW ;BIR/RTR - CPRS orders ;29-May-2012 14:50;PLS

 ;;7.0;OUTPATIENT PHARMACY;**1,7,15,46,71,98,111,124,117,131,146,132,1006,1009,143,223,235,148,239,249,225,1015**;DEC 1997;Build 62

 ;40.8-728,50-221,SC-2675,100-2219,50.7-2223,EN^ORERR-2187

 ;

 ; Modified - IHS/MSC/PLS - 10/26/07 - Added EN+31

 ;                          07/21/10 - Added I $G(PLACER) at EN+31

 ;                          08/06/10 - Line ZRN+4, New ZHM

EN(MSG) ;

 N PSODDRUG,ENTERED,LOCATION,PLACER,PSOOC,ROUTE,NATURE,PREV,ROUTING,OO,OR,STAT,ZZ,DFN,COMM,QCOUNT,OCOUNT,Q1I,QTARRAY,QTARRAY2,EE,PP,XOFLAG,PSODYSPL,PSOFILNM

 N ONEFLAG,SERV,WPCT,EFFECT,PROV,PENDING,RRX,PSOLQ1I,PSOLQ1II,PSOQWX,PSOLQ1IX,PSONVA,PSOICD,PSOSCP,EEE

 N OBXAR,AA,II,SIG1,FILLER,COMM,GG,FF,JJ,JJJ,CT,LIM,VAR,VAR1,QQQ,PSRNFLAG,PSRNQFLG,RCOMM,XOFLAGZ,NWFLAG,PFLAG,PSINPTR,INPTRX,PSOIBN,PSOIBY

 N DSIG,PSOCHFFL,PSOCVI,PSOMO,PSOXRP,NN,LL,LLL,WPARRAY,QTVAR,POVAR,POVAR1,ORCSEG,NNN,OOO,AAA,NNNN,POLIM,NNCK,PRIOR,IPPLACER,PLACERXX,EER,PSERRPID,PSERRPV1,PSERRORC,PSOEXFLG,PSOMSORR,PDFN,VAL

 S (SEND,PSOSND,OCOUNT)=0 K PSOPLC,PSOFFL,PSORSO,PSOSUSZ

 F OO=0:0 S OO=$O(MSG(OO)) Q:'OO!(SEND)!(PSOSND)  D:$P(MSG(OO),"|")="PID" SPDFN I $P(MSG(OO),"|")="ORC",$P(MSG(OO),"|",2)'="NW",$P(MSG(OO),"|",2)'="XO" D

 .S OR("STAT")=$P(MSG(OO),"|",2),OR("PLACE")=+$P(MSG(OO),"|",3),PLACERXX=+$P($P(MSG(OO),"|",3),";",2),OR("COMM")=$P(MSG(OO),"|",17),OR("USER")=$P(MSG(OO),"|",11) I $P(MSG(OO),"|",2)'="DE",$P(MSG(OO),"|",2)'="NA" S SEND=1 D FILL Q

 .S PSOPLC=+$P(MSG(OO),"|",3),PSOFFL=+$P(MSG(OO),"|",4),PSOSND=1,PSOCHFFL=$P($P(MSG(OO),"|",4),"^")

 I $G(OR("COMM"))["^" S OR("COMM")=$P(OR("COMM"),"^",5)

 I PSOSND,$G(PSOCHFFL)["S",$G(OR("STAT"))="NA" D CHCS^PSOHLNE1 Q

 I PSOSND,'$D(^PSRX(+$G(PSOFFL),0)) S COMM="Order was not located by Pharmacy" D EN^ORERR(COMM,.MSG) D KL Q

 I PSOSND,$G(PDFN),PDFN'=+$P($G(^PSRX(+$G(PSOFFL),0)),"^",2) S COMM="Patient does not match" D EN^ORERR(COMM,.MSG) D KL Q

 I PSOSND,$G(OR("STAT"))'="DE" N PSONAS S PSONAS=$S($P($G(^PSRX(PSOFFL,"OR1")),"^",2)="":1,1:0) S $P(^PSRX(PSOFFL,"OR1"),"^",2)=PSOPLC,^PSRX("APL",PSOPLC,PSOFFL)="" D:PSONAS EN^PSOHDR("PRES",PSOFFL) D KL Q

 D KL

 I SEND,$G(OR("STAT"))="Z@" G PURGE^PSOHLNE2

 I SEND,$G(OR("STAT"))="ZF" G REF^PSOHLNE2

 I SEND,$G(OR("STAT"))'="CA",$G(OR("STAT"))'="DC",$G(OR("STAT"))'="HD",$G(OR("STAT"))'="RL",$G(OR("STAT"))'="SS" S RCOMM="Invalid Order Control Code" D EN^ORERR(RCOMM,.MSG) Q

 I SEND K SEND G:$G(OR("STAT"))="SS" ESTAT D EN^PSOORUTL(.OR) S PLACER=OR("PLACE"),STAT=OR("STAT"),COMM=OR("COMM") S PSOMSORR=1 D  K PSOMSORR Q

 .I $G(OR("FILLER"))="" D  D ERROR^PSOHLSN Q

 ..F EER=0:0 S EER=$O(MSG(EER)) Q:'EER  S:$P(MSG(EER),"|")="PV1" PSERRPV1=MSG(EER) S:$P(MSG(EER),"|")="PID" PSERRPID=MSG(EER) S:$P(MSG(EER),"|")="ORC"&($G(PSERRORC)="") PSERRORC=MSG(EER)

 .I $P(OR("FILLER"),"^",2)="R" S FILLER=$P(OR("FILLER"),"^") D EN^PSOHLSN1(FILLER,STAT,$G(OR("PHARMST")),COMM) K:$G(PSOEXFLG) PSOMSORR,PLACERXX D:$G(PSOEXFLG) EN^PSOHLSN1(FILLER,"SC","ZE","") D:$G(PSOSUSZ) SUS^PSOORUT1 K PSOSUSZ Q

 .D EN^PSOHLSN(PLACER,STAT,COMM) Q

 D KL^PSOHLSIH S RRX=1 F ZZ=0:0 S ZZ=$O(MSG(ZZ)) Q:'ZZ  S PSOSEG=$G(MSG(ZZ)),PSOTYPE=$P(PSOSEG,"|") S PSOSEG=$E(PSOSEG,5,$L(PSOSEG)) I PSOTYPE'="NTE" D @PSOTYPE

 I $G(PSRNFLAG) S PSOMO=0 D MISRN^PSOHLNE1 I $G(PSOMO) Q

 S PSRNQFLG=0 I $G(PSRNFLAG),$G(PREV) D  I $G(PSRNQFLG) S RCOMM="Duplicate Renewal Request. Order rejected by Pharmacy." D EN^ORERR(RCOMM,.MSG) D RERROR^PSOHLSN D KL^PSOHLSIH Q

 .I $P($G(^PSRX(PREV,"OR1")),"^",4) S PSRNQFLG=1 Q

 .I $O(^PS(52.41,"AQ",PREV,0)) S PSRNQFLG=1

 .I $G(XOFLAG),$G(DFN)'=$S($G(PFLAG):$P($G(^PS(52.41,+$G(PREV),0)),"^",2),1:$P($G(^PSRX(+$G(PREV),0)),"^",2)) S RCOMM="Patient mismatch on previous order." D EN^ORERR(RCOMM,.MSG) S XOFLAGZ=1 D RERROR^PSOHLSN D KL^PSOHLSIH Q

 I $G(PLACER) I $G(DFN)'=+$P($G(^OR(100,+PLACER,0)),"^",2) G MISX^PSOHLNE1

 I $G(PLACER) D NFILE

 I $G(PLACER) D EN^APSPELRX(PLACER) ;IHS/MSC/PLS - 10/25/07 - ePrescribing interface

 D KL^PSOHLSIH

 Q

ESTAT ;

 D EXP^PSOHLNE1

 Q

MSH Q

PID S DFN=+$P(PSOSEG,"|",3)

 Q

PV1 S LOCATION=+$P(+$P(PSOSEG,"|",3),"^")

 S:'$D(^SC(LOCATION,0)) LOCATION=""

 S INPTRX=0 I $G(LOCATION) S PSINPTR=$P($G(^SC(LOCATION,0)),"^",4) I PSINPTR Q

 I $G(LOCATION) S INPTRX=$P($G(^SC(LOCATION,0)),"^",15)

 I '$G(INPTRX) S INPTRX=$O(^DG(40.8,0))

 I '$G(DT) S DT=$$DT^XLFDT

 S PSINPTR=+$$SITE^VASITE(DT,INPTRX)

 Q

OBR ;This segment is used to pass flagging information from CPRS.

 D OBR^PSOHLNE4

 Q

DG1 S $P(PSOICD($P(PSOSEG,"|",1)),"^")=$P($P(PSOSEG,"|",3),"^")

 Q

ORC ;

 Q:$P(PSOSEG,"|")="DE"

 S:$P(PSOSEG,"|")="XO" XOFLAG=1 D ^PSOHLNE1 S:$G(PRIOR)="A" PRIOR="E" S:$G(PRIOR)="" PRIOR="R"

 Q

 ;

RXO I $O(MSG(ZZ,0)) D ^PSOHLNE2 G RXOPS

 S PSORDITE=$P($P(PSOSEG,"|"),"^",4)

 S PSODDRUG=$P($P(PSOSEG,"|",10),"^",4) I $G(PSODDRUG) S:'$D(^PSDRUG(PSODDRUG,0)) PSODDRUG=""

 S PSOXQTY=$P(PSOSEG,"|",11)

 S PSOREFIL=$P(PSOSEG,"|",13)

 S PSODYSPL=$P(PSOSEG,"|",17)

RXOPS S ONEFLAG=0,WPCT=1,LL=ZZ+1

 I $P($G(MSG(LL)),"|")="NTE" D

 .S ONEFLAG=1,WORDP=$S($P(MSG(LL),"|",2):$P(MSG(LL),"|",2),1:$P(MSG(LL),"|",3)) S:$P(MSG(LL),"|",4)'="" WPARRAY(WORDP,WPCT)=$P(MSG(LL),"|",4) S:$P(MSG(LL),"|",4)'="" WPCT=WPCT+1 F LLL=0:0 S LLL=$O(MSG(LL,LLL)) Q:'LLL  D

 ..I $G(MSG(LL,LLL))'="" S WPARRAY(WORDP,WPCT)=$G(MSG(LL,LLL)),WPCT=WPCT+1

 I ONEFLAG S LL=LL+1 I $P($G(MSG(LL)),"|")="NTE" D NTE^PSOHLNE1

 K WORDP

 Q

RXR I $P($P(PSOSEG,"|"),"^",4) S ROUTE(RRX)=$P($P(PSOSEG,"|"),"^",4) S RRX=RRX+1

 Q

OBX I $O(MSG(ZZ,0)) D OBXX^PSOHLNE2 G OBXNTE

 S OCOUNT=OCOUNT+1

 S OBXAR(OCOUNT,1)=$P(PSOSEG,"|",5)

OBXNTE ;

 D OBXNTE^PSOHLNE3

 Q

ZRN S PSODSC=1_"^"_$P(PSOSEG,"|",2)

 I $O(MSG(ZZ,0)) F T=0:0 S T=$O(MSG(ZZ,T)) Q:'T  S PSODSC(T)=MSG(ZZ,T)

 K T

 ;IHS/MSC/REC/PLS - 08/06/2010 - New fields for Med Rec

 S MSCLD=$$HL7TFM^XLFDT($P(PSOSEG,"|",3)),MSCHMLST=$P(PSOSEG,"|",4),MSCHMLOC=$P(PSOSEG,"|",5)

 Q

ZHM ;IHS/MCS/REC/PLS - 08/06/2010 - Reason field support for Med Rec

 I $P(PSOSEG,"|")'="" S MSCRSN($P(PSOSEG,"|"))=$P(PSOSEG,"|",2)

 Q

 ;

ZRX D ZRX^PSOHLNE1

 Q

 ;

ZCL D ZCL^PSOHLNE1

 Q

ZSC D CP^PSOHLNE1

 Q

NFILE ;

 I $G(PSODSC) D ^PSONVNEW Q  ;adds non-va med to #55

 ;

 K DD,DO,DIC S DLAYGO="52.41",DIC="^PS(52.41,",DIC(0)="L",X=PLACER,DIC("DR")="1////"_DFN_";2////"_PSOOC_";6////"_$G(EFFECT)_";12////"_$G(PSOXQTY)_";25////"_$G(PRIOR)

 S DIC("DR")=DIC("DR")_";22////"_$G(PSORSO)_";22.1////"_$G(PREV)_";19////"_$G(ROUTING)_";17////"_$$UNESC^ORHLESC($G(SERV))_";7////"_$G(NATURE)_";13////"_$G(PSOREFIL)_";1.1////"_$G(LOCATION)_";117////"_$G(DSIG)

 D FILE^DICN K DIC,DR I Y<0 Q

 S PENDING=+Y

 S $P(^PS(52.41,PENDING,0),"^",4)=$S($G(ENTERED):+$G(ENTERED),1:""),$P(^(0),"^",5)=$S($G(PROV):+$G(PROV),1:""),$P(^(0),"^",8)=$S($G(PSORDITE):+$G(PSORDITE),1:""),$P(^(0),"^",9)=$S($G(PSODDRUG):+$G(PSODDRUG),1:""),$P(^(0),"^",15)=$G(ROUTE)

 S ^PS(52.41,PENDING,"IBQ")=$G(PSOIBY)

 I $G(PSODYSPL)'="",$E(PSODYSPL)?1A S PSODYSPL=$E(PSODYSPL,2,$L(PSODYSPL))

 S $P(^PS(52.41,PENDING,"INI"),"^")=$G(PSINPTR),$P(^(0),"^",12)=$G(PSOLOG),$P(^(0),"^",22)=$G(PSODYSPL)

 I $G(QCOUNT) S ^PS(52.41,PENDING,1,0)="^52.413^"_QCOUNT_"^"_QCOUNT

 S PSOQWX=$G(PSODDRUG) D:'$G(PSOQWX) OID^PSOHLNE1

 F PP=0:0 S PP=$O(Q1I(PP)) Q:'PP  S VAL=$S($G(PSOQWX)&($G(PSOLQ1II(PP))):Q1I(PP),$G(PSOQWX)&($G(PSOLQ1IX(PP))'="")&('$G(PSOLQ1II(PP))):PSOLQ1IX(PP),1:PSOLQ1I(PP)) S ^PS(52.41,PENDING,1,PP,0)=$$UNESC^ORHLESC(VAL)

 F EE=0:0 S EE=$O(QTARRAY(EE)) Q:'EE  S ^PS(52.41,PENDING,1,EE,1)=$$UNESC^ORHLESC(QTARRAY(EE)) S VAL=$S($G(PSOQWX)&($G(PSOLQ1II(EE))):$G(QTARRAY2(EE)),$G(PSOQWX)&($G(PSOLQ1IX(EE))'="")&('$G(PSOLQ1II(EE))):PSOLQ1IX(EE),1:$G(PSOLQ1I(EE))) D

 .S ^PS(52.41,PENDING,1,EE,2)=$$UNESC^ORHLESC(VAL) S $P(^PS(52.41,PENDING,1,EE,1),"^",8)=+$G(ROUTE(EE))

 S:$P($G(^PS(52.41,PENDING,1,1,1)),"^",3) $P(^PS(52.41,PENDING,0),"^",18)=$E($P($G(^PS(52.41,PENDING,1,1,1)),"^",3),1,7)

 D STUFF^PSOHLNE2

 D ^PSOHLPII

 S LL=0 I $O(WPARRAY(6,0)) F LLL=0:0 S LLL=$O(WPARRAY(6,LLL)) Q:'LLL  S LL=LL+1 S ^PS(52.41,PENDING,3,LL,0)=$$UNESC^ORHLESC($G(WPARRAY(6,LLL)))

 I LL S ^PS(52.41,PENDING,3,0)="^52.42^"_LL_"^"_LL

 S LL=0 I $O(WPARRAY(7,0)) F LLL=0:0 S LLL=$O(WPARRAY(7,LLL)) Q:'LLL  S LL=LL+1 S ^PS(52.41,PENDING,"INS1",LL,0)=$$UNESC^ORHLESC($G(WPARRAY(7,LLL)))

 I LL S ^PS(52.41,PENDING,"INS1",0)="^^"_LL_"^"_LL_"^"_$G(DT)_"^"

 I $P($G(^PS(50.7,+$G(PSORDITE),"INS")),"^")'="" S $P(^PS(52.41,PENDING,"INS"),"^",2)=$S($O(^PS(52.41,PENDING,"INS1",0)):1,1:0)

 I $G(OCOUNT) S ^PS(52.41,PENDING,"OBX",0)="^52.4118A^"_OCOUNT_"^"_OCOUNT F OCOUNT=1:1:OCOUNT D

 .S ^PS(52.41,PENDING,"OBX",OCOUNT,0)=$$UNESC^ORHLESC($G(OBXAR(OCOUNT,1)))

 .D USER^PSOORFI2(+$G(PROV)) S ^PS(52.41,PENDING,"OBX",OCOUNT,1)=$$UNESC^ORHLESC(USER1) K USER1

 .S PSOBCT=1 F LLL=2:1 Q:'$D(OBXAR(OCOUNT,LLL))  S ^PS(52.41,PENDING,"OBX",OCOUNT,2,PSOBCT,0)=$$UNESC^ORHLESC(OBXAR(OCOUNT,LLL)),^PS(52.41,PENDING,"OBX",OCOUNT,2,0)="^^"_PSOBCT_"^"_PSOBCT_"^"_$G(DT)_"^"

 D ^PSOHLPIS

 K DIK S DIK="^PS(52.41,",DA=PENDING D IX^DIK

 I $G(PSOOC)="RNW",$G(PREV),$D(^PSRX(+$G(PREV),0)) D EN^PSOHLSN1(PREV,"SC","ZZ","")

 S PSOMSORR=1,IPPLACER=$P($G(^PS(52.41,PENDING,0)),"^") I IPPLACER D

 .I '$G(XOFLAG) D EN^PSOHLSN(IPPLACER,"OK","IP") Q

 .D EN^PSOHLSN(IPPLACER,"XR","IP") I $G(PFLAG) D DCP^PSOHLSN Q

 .K PSOMSORR I $D(^PSRX(+$G(PREV),0)) D  D EN^PSOHLSN1(PREV,"RP","","","A")

 ..S $P(^PSRX(PREV,"STA"),"^")=15,$P(^PSRX(PREV,3),"^",5)=DT,$P(^PSRX(PREV,3),"^",10)=$P(^PSRX(PREV,3),"^")  ;;PSO*7*249

 ..D REVERSE^PSOBPSU1(PREV,,"DC",7),CAN^PSOTPCAN(PREV),CAN^PSOUTL(PREV)

 ..D CNT^PSOHLNE1

 ..D:$G(^PS(52.41,PENDING,1,1,0))=""&($P($G(^PS(52.41,PENDING,1,1,1)),"^")="")&($G(^PS(52.41,PENDING,"SIG",1,0))="")

 ...N FSIG,BSIG

 ...I '$P($G(^PSRX(PREV,"SIG")),"^",2),$P($G(^("SIG")),"^")'="" D

 ....D EN3^PSOUTLA1(PREV,70)

 ....I $G(BSIG(1))'="" S ^PS(52.41,PENDING,"SIG",1,0)=$$UNESC^ORHLESC($G(BSIG(1))) I $O(BSIG(1)) F EE=1:0 S EE=$O(BSIG(EE)) Q:'EE  S ^PS(52.41,PENDING,"SIG",EE,0)=$$UNESC^ORHLESC($G(BSIG(EE)))

 ...I $P($G(^PSRX(PREV,"SIG")),"^",2),$G(^PSRX(PREV,"SIG1",1,0))'="" D

 ....D FSIG^PSOUTLA("R",PREV,70)

 ....I $G(FSIG(1))'="" S ^PS(52.41,PENDING,"SIG",1,0)=$$UNESC^ORHLESC($G(FSIG(1))) I $O(FSIG(1)) F EE=1:0 S EE=$O(FSIG(EE)) Q:'EE  S ^PS(52.41,PENDING,"SIG",EE,0)=$$UNESC^ORHLESC($G(FSIG(EE)))

 ...F EE=0:0 S EE=$O(^PS(52.41,PENDING,"SIG",EE)) Q:'EE  S ^PS(52.41,PENDING,"SIG",0)="^52.4124A^"_EE_"^"_EE

 D CSET^PSODIAG

 Q

SPDFN S PDFN=$P($G(MSG(OO)),"|",4) Q

KL K PSOPLC,PSOFFL,PSOSND

 Q

FILL ;

 S (PSOFILNM,OR("PSOFILNM"))=$P($P(MSG(OO),"|",4),"^")

 Q

PSOHLNEW  ;BIR/RTR - CPRS orders ;29-May-2012 14:50;PLS

 +1       ;;7.0;OUTPATIENT PHARMACY;**1,7,15,46,71,98,111,124,117,131,146,132,1006,1009,143,223,235,148,239,249,225,1015**;DEC 1997;Build 62

 +2       ;40.8-728,50-221,SC-2675,100-2219,50.7-2223,EN^ORERR-2187

 +3       ;

 +4       ; Modified - IHS/MSC/PLS - 10/26/07 - Added EN+31

 +5       ;                          07/21/10 - Added I $G(PLACER) at EN+31

 +6       ;                          08/06/10 - Line ZRN+4, New ZHM

EN(MSG)   ;

 +1        NEW PSODDRUG,ENTERED,LOCATION,PLACER,PSOOC,ROUTE,NATURE,PREV,ROUTING,OO,OR,STAT,ZZ,DFN,COMM,QCOUNT,OCOUNT,Q1I,QTARRAY,QTARRAY2,EE,PP,XOFLAG,PSODYSPL,PSOFILNM

 +2        NEW ONEFLAG,SERV,WPCT,EFFECT,PROV,PENDING,RRX,PSOLQ1I,PSOLQ1II,PSOQWX,PSOLQ1IX,PSONVA,PSOICD,PSOSCP,EEE

 +3        NEW OBXAR,AA,II,SIG1,FILLER,COMM,GG,FF,JJ,JJJ,CT,LIM,VAR,VAR1,QQQ,PSRNFLAG,PSRNQFLG,RCOMM,XOFLAGZ,NWFLAG,PFLAG,PSINPTR,INPTRX,PSOIBN,PSOIBY

 +4        NEW DSIG,PSOCHFFL,PSOCVI,PSOMO,PSOXRP,NN,LL,LLL,WPARRAY,QTVAR,POVAR,POVAR1,ORCSEG,NNN,OOO,AAA,NNNN,POLIM,NNCK,PRIOR,IPPLACER,PLACERXX,EER,PSERRPID,PSERRPV1,PSERRORC,PSOEXFLG,PSOMSORR,PDFN,VAL

 +5        SET (SEND,PSOSND,OCOUNT)=0

           KILL PSOPLC,PSOFFL,PSORSO,PSOSUSZ

 +6        FOR OO=0:0

               SET OO=$ORDER(MSG(OO))

               IF 'OO!(SEND)!(PSOSND)

                   QUIT 

               IF $PIECE(MSG(OO),"|")="PID"

                   DO SPDFN

               IF $PIECE(MSG(OO),"|")="ORC"

                   IF $PIECE(MSG(OO),"|",2)'="NW"

                       IF $PIECE(MSG(OO),"|",2)'="XO"

                           Begin DoDot:1

 +7                            SET OR("STAT")=$PIECE(MSG(OO),"|",2)

                               SET OR("PLACE")=+$PIECE(MSG(OO),"|",3)

                               SET PLACERXX=+$PIECE($PIECE(MSG(OO),"|",3),";",2)

                               SET OR("COMM")=$PIECE(MSG(OO),"|",17)

                               SET OR("USER")=$PIECE(MSG(OO),"|",11)

                               IF $PIECE(MSG(OO),"|",2)'="DE"

                                   IF $PIECE(MSG(OO),"|",2)'="NA"

                                       SET SEND=1

                                       DO FILL

                                       QUIT 

 +8                            SET PSOPLC=+$PIECE(MSG(OO),"|",3)

                               SET PSOFFL=+$PIECE(MSG(OO),"|",4)

                               SET PSOSND=1

                               SET PSOCHFFL=$PIECE($PIECE(MSG(OO),"|",4),"^")

                           End DoDot:1

 +9        IF $GET(OR("COMM"))["^"

               SET OR("COMM")=$PIECE(OR("COMM"),"^",5)

 +10       IF PSOSND

               IF $GET(PSOCHFFL)["S"

                   IF $GET(OR("STAT"))="NA"

                       DO CHCS^PSOHLNE1

                       QUIT 

 +11       IF PSOSND

               IF '$DATA(^PSRX(+$GET(PSOFFL),0))

                   SET COMM="Order was not located by Pharmacy"

                   DO EN^ORERR(COMM,.MSG)

                   DO KL

                   QUIT 

 +12       IF PSOSND

               IF $GET(PDFN)

                   IF PDFN'=+$PIECE($GET(^PSRX(+$GET(PSOFFL),0)),"^",2)

                       SET COMM="Patient does not match"

                       DO EN^ORERR(COMM,.MSG)

                       DO KL

                       QUIT 

 +13       IF PSOSND

               IF $GET(OR("STAT"))'="DE"

                   NEW PSONAS

                   SET PSONAS=$SELECT($PIECE($GET(^PSRX(PSOFFL,"OR1")),"^",2)="":1,1:0)

                   SET $PIECE(^PSRX(PSOFFL,"OR1"),"^",2)=PSOPLC

                   SET ^PSRX("APL",PSOPLC,PSOFFL)=""

                   IF PSONAS

                       DO EN^PSOHDR("PRES",PSOFFL)

                   DO KL

                   QUIT 

 +14       DO KL

 +15       IF SEND

               IF $GET(OR("STAT"))="Z@"

                   GOTO PURGE^PSOHLNE2

 +16       IF SEND

               IF $GET(OR("STAT"))="ZF"

                   GOTO REF^PSOHLNE2

 +17       IF SEND

               IF $GET(OR("STAT"))'="CA"

                   IF $GET(OR("STAT"))'="DC"

                       IF $GET(OR("STAT"))'="HD"

                           IF $GET(OR("STAT"))'="RL"

                               IF $GET(OR("STAT"))'="SS"

                                   SET RCOMM="Invalid Order Control Code"

                                   DO EN^ORERR(RCOMM,.MSG)

                                   QUIT 

 +18       IF SEND

               KILL SEND

               IF $GET(OR("STAT"))="SS"

                   GOTO ESTAT

               DO EN^PSOORUTL(.OR)

               SET PLACER=OR("PLACE")

               SET STAT=OR("STAT")

               SET COMM=OR("COMM")

               SET PSOMSORR=1

               Begin DoDot:1

 +19               IF $GET(OR("FILLER"))=""

                       Begin DoDot:2

 +20                       FOR EER=0:0

                               SET EER=$ORDER(MSG(EER))

                               IF 'EER

                                   QUIT 

                               IF $PIECE(MSG(EER),"|")="PV1"

                                   SET PSERRPV1=MSG(EER)

                               IF $PIECE(MSG(EER),"|")="PID"

                                   SET PSERRPID=MSG(EER)

                               IF $PIECE(MSG(EER),"|")="ORC"&($GET(PSERRORC)="")

                                   SET PSERRORC=MSG(EER)

                       End DoDot:2

                       DO ERROR^PSOHLSN

                       QUIT 

 +21               IF $PIECE(OR("FILLER"),"^",2)="R"

                       SET FILLER=$PIECE(OR("FILLER"),"^")

                       DO EN^PSOHLSN1(FILLER,STAT,$GET(OR("PHARMST")),COMM)

                       IF $GET(PSOEXFLG)

                           KILL PSOMSORR,PLACERXX

                       IF $GET(PSOEXFLG)

                           DO EN^PSOHLSN1(FILLER,"SC","ZE","")

                       IF $GET(PSOSUSZ)

                           DO SUS^PSOORUT1

                       KILL PSOSUSZ

                       QUIT 

 +22               DO EN^PSOHLSN(PLACER,STAT,COMM)

                   QUIT 

               End DoDot:1

               KILL PSOMSORR

               QUIT 

 +23       DO KL^PSOHLSIH

           SET RRX=1

           FOR ZZ=0:0

               SET ZZ=$ORDER(MSG(ZZ))

               IF 'ZZ

                   QUIT 

               SET PSOSEG=$GET(MSG(ZZ))

               SET PSOTYPE=$PIECE(PSOSEG,"|")

               SET PSOSEG=$EXTRACT(PSOSEG,5,$LENGTH(PSOSEG))

               IF PSOTYPE'="NTE"

                   DO @PSOTYPE

 +24       IF $GET(PSRNFLAG)

               SET PSOMO=0

               DO MISRN^PSOHLNE1

               IF $GET(PSOMO)

                   QUIT 

 +25       SET PSRNQFLG=0

           IF $GET(PSRNFLAG)

               IF $GET(PREV)

                   Begin DoDot:1

 +26                   IF $PIECE($GET(^PSRX(PREV,"OR1")),"^",4)

                           SET PSRNQFLG=1

                           QUIT 

 +27                   IF $ORDER(^PS(52.41,"AQ",PREV,0))

                           SET PSRNQFLG=1

 +28                   IF $GET(XOFLAG)

                           IF $GET(DFN)'=$SELECT($GET(PFLAG):$PIECE($GET(^PS(52.41,+$GET(PREV),0)),"^",2),1:$PIECE($GET(^PSRX(+$GET(PREV),0)),"^",2))

                               SET RCOMM="Patient mismatch on previous order."

                               DO EN^ORERR(RCOMM,.MSG)

                               SET XOFLAGZ=1

                               DO RERROR^PSOHLSN

                               DO KL^PSOHLSIH

                               QUIT 

                   End DoDot:1

                   IF $GET(PSRNQFLG)

                       SET RCOMM="Duplicate Renewal Request. Order rejected by Pharmacy."

                       DO EN^ORERR(RCOMM,.MSG)

                       DO RERROR^PSOHLSN

                       DO KL^PSOHLSIH

                       QUIT 

 +29       IF $GET(PLACER)

               IF $GET(DFN)'=+$PIECE($GET(^OR(100,+PLACER,0)),"^",2)

                   GOTO MISX^PSOHLNE1

 +30       IF $GET(PLACER)

               DO NFILE

 +31      ;IHS/MSC/PLS - 10/25/07 - ePrescribing interface

           IF $GET(PLACER)

               DO EN^APSPELRX(PLACER)

 +32       DO KL^PSOHLSIH

 +33       QUIT 

ESTAT     ;

 +1        DO EXP^PSOHLNE1

 +2        QUIT 

MSH        QUIT 

PID        SET DFN=+$PIECE(PSOSEG,"|",3)

 +1        QUIT 

PV1        SET LOCATION=+$PIECE(+$PIECE(PSOSEG,"|",3),"^")

 +1        IF '$DATA(^SC(LOCATION,0))

               SET LOCATION=""

 +2        SET INPTRX=0

           IF $GET(LOCATION)

               SET PSINPTR=$PIECE($GET(^SC(LOCATION,0)),"^",4)

               IF PSINPTR

                   QUIT 

 +3        IF $GET(LOCATION)

               SET INPTRX=$PIECE($GET(^SC(LOCATION,0)),"^",15)

 +4        IF '$GET(INPTRX)

               SET INPTRX=$ORDER(^DG(40.8,0))

 +5        IF '$GET(DT)

               SET DT=$$DT^XLFDT

 +6        SET PSINPTR=+$$SITE^VASITE(DT,INPTRX)

 +7        QUIT 

OBR       ;This segment is used to pass flagging information from CPRS.

 +1        DO OBR^PSOHLNE4

 +2        QUIT 

DG1        SET $PIECE(PSOICD($PIECE(PSOSEG,"|",1)),"^")=$PIECE($PIECE(PSOSEG,"|",3),"^")

 +1        QUIT 

ORC       ;

 +1        IF $PIECE(PSOSEG,"|")="DE"

               QUIT 

 +2        IF $PIECE(PSOSEG,"|")="XO"

               SET XOFLAG=1

           DO ^PSOHLNE1

           IF $GET(PRIOR)="A"

               SET PRIOR="E"

           IF $GET(PRIOR)=""

               SET PRIOR="R"

 +3        QUIT 

 +4       ;

RXO        IF $ORDER(MSG(ZZ,0))

               DO ^PSOHLNE2

               GOTO RXOPS

 +1        SET PSORDITE=$PIECE($PIECE(PSOSEG,"|"),"^",4)

 +2        SET PSODDRUG=$PIECE($PIECE(PSOSEG,"|",10),"^",4)

           IF $GET(PSODDRUG)

               IF '$DATA(^PSDRUG(PSODDRUG,0))

                   SET PSODDRUG=""

 +3        SET PSOXQTY=$PIECE(PSOSEG,"|",11)

 +4        SET PSOREFIL=$PIECE(PSOSEG,"|",13)

 +5        SET PSODYSPL=$PIECE(PSOSEG,"|",17)

RXOPS      SET ONEFLAG=0

           SET WPCT=1

           SET LL=ZZ+1

 +1        IF $PIECE($GET(MSG(LL)),"|")="NTE"

               Begin DoDot:1

 +2                SET ONEFLAG=1

                   SET WORDP=$SELECT($PIECE(MSG(LL),"|",2):$PIECE(MSG(LL),"|",2),1:$PIECE(MSG(LL),"|",3))

                   IF $PIECE(MSG(LL),"|",4)'=""

                       SET WPARRAY(WORDP,WPCT)=$PIECE(MSG(LL),"|",4)

                   IF $PIECE(MSG(LL),"|",4)'=""

                       SET WPCT=WPCT+1

                   FOR LLL=0:0

                       SET LLL=$ORDER(MSG(LL,LLL))

                       IF 'LLL

                           QUIT 

                       Begin DoDot:2

 +3                        IF $GET(MSG(LL,LLL))'=""

                               SET WPARRAY(WORDP,WPCT)=$GET(MSG(LL,LLL))

                               SET WPCT=WPCT+1

                       End DoDot:2

               End DoDot:1

 +4        IF ONEFLAG

               SET LL=LL+1

               IF $PIECE($GET(MSG(LL)),"|")="NTE"

                   DO NTE^PSOHLNE1

 +5        KILL WORDP

 +6        QUIT 

RXR        IF $PIECE($PIECE(PSOSEG,"|"),"^",4)

               SET ROUTE(RRX)=$PIECE($PIECE(PSOSEG,"|"),"^",4)

               SET RRX=RRX+1

 +1        QUIT 

OBX        IF $ORDER(MSG(ZZ,0))

               DO OBXX^PSOHLNE2

               GOTO OBXNTE

 +1        SET OCOUNT=OCOUNT+1

 +2        SET OBXAR(OCOUNT,1)=$PIECE(PSOSEG,"|",5)

OBXNTE    ;

 +1        DO OBXNTE^PSOHLNE3

 +2        QUIT 

ZRN        SET PSODSC=1_"^"_$PIECE(PSOSEG,"|",2)

 +1        IF $ORDER(MSG(ZZ,0))

               FOR T=0:0

                   SET T=$ORDER(MSG(ZZ,T))

                   IF 'T

                       QUIT 

                   SET PSODSC(T)=MSG(ZZ,T)

 +2        KILL T

 +3       ;IHS/MSC/REC/PLS - 08/06/2010 - New fields for Med Rec

 +4        SET MSCLD=$$HL7TFM^XLFDT($PIECE(PSOSEG,"|",3))

           SET MSCHMLST=$PIECE(PSOSEG,"|",4)

           SET MSCHMLOC=$PIECE(PSOSEG,"|",5)

 +5        QUIT 

ZHM       ;IHS/MCS/REC/PLS - 08/06/2010 - Reason field support for Med Rec

 +1        IF $PIECE(PSOSEG,"|")'=""

               SET MSCRSN($PIECE(PSOSEG,"|"))=$PIECE(PSOSEG,"|",2)

 +2        QUIT 

 +3       ;

ZRX        DO ZRX^PSOHLNE1

 +1        QUIT 

 +2       ;

ZCL        DO ZCL^PSOHLNE1

 +1        QUIT 

ZSC        DO CP^PSOHLNE1

 +1        QUIT