PSOORFI4.m

PSOORFI4 ;BIR/SAB-CPRS order checks and display con't ;07-Dec-2012 08:59;PLS

 ;;7.0;OUTPATIENT PHARMACY;**46,74,78,99,117,131,1013,207,258,274,300,308,1015**;DEC 1997;Build 62

 ;External reference to ^PS(51.2 supported by DBIA 2226

 ;External reference to ^PS(50.607 supported by DBIA 2221

 ;External reference ^PS(55 supported by DBIA 2228

 ;External reference to ^PS(50.7 is supported by DBIA 2223

 ;

 ; Modified - IHS/CIA/PLS - 02/13/04 - Line PROVCOM+6 and new EXPPRC API

 ;            IHS/MSC/PLS - 05/10/10 - Moved PROVCOM+6 change to PROVCOM+19

 ;            IHS/MSC/PLS - 09/21/11 - Line OBX+2

 ;                        - 09/28/11 - Line PROVCOM+2

 ;                        - 12/07/12 - Line REF+8

ORCHK D ORCHK^PSOORNE6

 Q

INST ;displays patient instructions

 I $O(PSONEW("SIG",0)) G INST1

 S INST=0 F  S INST=$O(^PS(52.41,ORD,"INS1",INST)) Q:'INST  S (MIG,PSONEW("SIG",INST))=^PS(52.41,ORD,"INS1",INST,0) D

 .F SG=1:1:$L(MIG," ") S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(MIG," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",20)=" " S ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(MIG," ",SG)

 I $P($G(^PS(55,PSODFN,"LAN")),"^"),$O(^PS(52.41,ORD,"INS1",0)) D

 .I $G(^PS(50.7,PSODRUG("OI"),"INS1"))]"" S (X,PSONEW("SINS"))=^PS(50.7,PSODRUG("OI"),"INS1") D SSIG^PSOHELP

 .I $G(SINS1)]"" S PSONEW("SINS")=$E(SINS1,2,250)

 .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Other Pat Instruct: "_$S($G(PSONEW("SINS"))]"":PSONEW("SINS"),1:"")

 K INST,TY,MIG,SG,SINS1

 Q

INST1 ;

 S INS=0 F  S INS=$O(PSONEW("SIG",INS)) Q:'INS  S MIG=PSONEW("SIG",INS) D

 .F SG=1:1:$L(MIG," ") S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(MIG," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",20)=" " S ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(MIG," ",SG)

 K INST,TY,MIG,SG

 I $P($G(^PS(55,PSODFN,"LAN")),"^") S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Other Pat Instruct: "_$S($G(PSONEW("SINS"))]"":PSONEW("SINS"),1:"")

 Q

PROVCOM ;

 I $G(PKI1)=1,'$G(PSORX("VERIFY")) D REA^PSOPKIV1 Q:$G(PSORX("DFLG"))

 ;IHS/MSC/PLS - 09/28/2011

 ;I $O(PRC(0)),'$G(PSOPRC) D  D KV^PSOVER1

 N APSPSARY M APSPSARY=PSONEW("SIG")

 I $O(PRC(0)),'$G(PSOPRC),'$$SRCHARY^APSPFUNC(.APSPSARY,.PRC) D  D KV^PSOVER1

 .D EN^DDIOL("Provider Comments: ","","!")

 .F I=0:0 S I=$O(PRC(I)) Q:'I  D EN^DDIOL(PRC(I),"","!")

 .D KV^PSOVER1 S DIR(0)="Y",DIR("A")="Copy Provider Comments into the Patient Instructions",DIR("B")="No"

 .D ^DIR Q:'Y!($D(DIRUT))

 .;Check Provider Comments.  If any line contains more than 32

 .;characters with no spaces, display error message and quit.

 .;*308

 .I $$CHKCOM(.PRC) D  Q

 ..N X,Y,DIR,DIRUT,DUOUT,MSG

 ..S MSG(1)="*** Provider Comments CANNOT be copied ***"

 ..S MSG(1,"F")="!,$C(7)"

 ..S MSG(2)="They contain a word longer than 32 characters, which is not allowed in"

 ..S MSG(3)="the Patient Instructions.  You need to enter this manually."

 ..D EN^DDIOL(.MSG)

 ..S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR

 .S PSOPRC=1,NI=0 F I=0:0 S I=$O(PSONEW("SIG",I)) Q:'I  S NI=I

 .D EXPPRC(.PRC)  ; IHS/CIA/PLS - 02/13/04 - Fix to expand provider comments

 .S NC=0 F I=0:0 S I=$O(PRC(I)) Q:'I  S NC=NC+1

 .I NI'>1,NC=1,($L($G(PSONEW("SIG",NI)))+$L(PRC(1)))'>250 D  Q

 ..S X=PRC(1) D SIGONE^PSOHELP

 ..S PSONEW("SIG",1)=$G(PSONEW("SIG",NI))_INS1 K INS1,X

 ..S:$E(PSONEW("SIG",1))=" " PSONEW("SIG",1)=$E(PSONEW("SIG",1),2,250) S PSONEW("INS")=PSONEW("SIG",1) D EN^PSOFSIG(.PSONEW,1) K NI,NC

 .F I=0:0 S I=$O(PRC(I)) Q:'I  S NI=NI+1,(PSONEW("INS",NI),X)=PRC(I) D SIGONE^PSOHELP S PSONEW("SIG",NI)=INS1 K INS1

 .I $E(PSONEW("SIG",1))=" " S PSONEW("SIG",1)=$E(PSONEW("SIG",1),2,250)

 .D EN^PSOFSIG(.PSONEW,1) K NI,NC,X

 Q

CHKCOM(PRC) ;Check provider comments array PRC. If any comment line is longer than 32 characters with no spaces, return 1

 ;*308

 ;INPUT:  PRC( = Provider Comments array

 ;OUTPUT: PSOERR  = O - OK

 ;                = 1 - Error (Comments > 32 chars. w/ no spaces)

 N PSOX,PSOY,PSOZ,PSOERR

 S PSOERR=0

 I '$D(PRC) Q PSOERR

 S PSOX=0

 F  S PSOX=$O(PRC(PSOX)) Q:PSOX=""!PSOERR  I $L(PRC(PSOX))>32 D

 .S PSOZ=$L(PRC(PSOX)," ") F PSOY=1:1:PSOZ I $L($P(PRC(PSOX)," ",PSOY))>32 S PSOERR=1 Q

 Q PSOERR

DOSE ;displays dosing info for pending orders.  called from psoorfi1

 K II,UNITS S DS=1

 I '$O(^PS(52.41,ORD,1,0)) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (3)        *Dosage:" G DOSEX

 F I=0:0 S I=$O(^PS(52.41,ORD,1,I)) Q:'I  S DOSE=$G(^PS(52.41,ORD,1,I,1)),DOSE1=$G(^(2)) D  D DOSE1

 .S II=$G(II)+1 K PSONEW("UNITS",II)

 .S PSONEW("DOSE",II)=$P(DOSE1,"^"),PSONEW("DOSE ORDERED",II)=$P(DOSE1,"^",2),PSONEW("UNITS",II)=$P(DOSE,"^",9),PSONEW("NOUN",II)=$P(DOSE,"^",5)

 .S:$P(DOSE,"^",9) UNITS=$P(^PS(50.607,$P(DOSE,"^",9),0),"^")

 .S PSONEW("VERB",II)=$P(DOSE,"^",10),PSONEW("ROUTE",II)=$P(DOSE,"^",8)

 .S:$P(DOSE,"^",8) ROUTE=$P(^PS(51.2,$P(DOSE,"^",8),0),"^")

 .S PSONEW("SCHEDULE",II)=$P(DOSE,"^"),PSONEW("DURATION",II)=$P(DOSE,"^",2)

 .S DOENT=$G(DOENT)+1 I $P(DOSE,"^",6)]"" S PSONEW("CONJUNCTION",II)=$S($P(DOSE,"^",6)="S":"T",$P(DOSE,"^",6)="X":"X",1:"A")

 .I 'PSONEW("DOSE ORDERED",II),$G(PSONEW("VERB",II))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="               Verb: "_$G(PSONEW("VERB",II))

 .S:$G(DS) IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (3)"

DOSEX S PSONEW("ENT")=+$G(II) K DOSE,DOSE1,II,I,UNITS,ROUTE,DG

 Q

DOSE1 I $G(DS)=1 S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_"        *Dosage:" D FMD^PSOORFI3 G DU

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="            *Dosage:" D FMD^PSOORFI3

DU I 'PSONEW("DOSE ORDERED",I),$P($G(^PS(55,PSODFN,"LAN")),"^") S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" *Oth. Lang. Dosage: "_$G(PSONEW("ODOSE",I))

 I PSONEW("DOSE ORDERED",II),$G(PSONEW("VERB",II))]"" D

 .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="               Verb: "_$G(PSONEW("VERB",II))

 .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="     Dispense Units: "_$S($E(PSONEW("DOSE ORDERED",II),1)=".":"0",1:"")_PSONEW("DOSE ORDERED",II)

 I PSONEW("NOUN",II)]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="               Noun: "_PSONEW("NOUN",II)

 I $G(ROUTE)]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="             *Route: "_$G(ROUTE)

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="          *Schedule: "_PSONEW("SCHEDULE",II)

 I $G(PSONEW("DURATION",II))]"" D

 .S PSONEW("DURATION",II)=$S($E(PSONEW("DURATION",II),1)'?.N:$E(PSONEW("DURATION",II),2,99)_$E(PSONEW("DURATION",II),1),1:PSONEW("DURATION",II))

 .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="          *Duration: "_PSONEW("DURATION",II)_" ("_$S(PSONEW("DURATION",II)["M":"MINUTES",PSONEW("DURATION",II)["H":"HOURS",PSONEW("DURATION",II)["L":"MONTHS",PSONEW("DURATION",II)["W":"WEEKS",1:"DAYS")_")"

 I $G(PSONEW("CONJUNCTION",II))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="       *Conjunction: "_$S(PSONEW("CONJUNCTION",II)="T":"THEN",PSONEW("CONJUNCTION",II)="X":"EXCEPT",1:"AND")

 Q

DOSE2 ;displays pending order after edits.  called from psoornew

 I '$O(PSONEW("DOSE",0))!($O(PSONEW("DOSE",0))="") S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (3)        *Dosage:" Q

 S DS=1

 F I=1:1:PSONEW("ENT") Q:'I  D  D DOSE3 K COJ

 .S:$G(PSONEW("UNITS",I))]"" UNITS=$P(^PS(50.607,PSONEW("UNITS",I),0),"^")

 .I $G(PSONEW("ROUTE",I))]"",$G(^PS(51.2,PSONEW("ROUTE",I),0))]"" S ROUTE=$P(^PS(51.2,PSONEW("ROUTE",I),0),"^")

 .S DUR=$G(PSONEW("DURATION",I)) S:$G(PSONEW("CONJUNCTION",I))]"" COJ=PSONEW("CONJUNCTION",I)

 .S NOUN=$G(PSONEW("NOUN",I)),VERB=$G(PSONEW("VERB",I))

 .I '$G(PSONEW("DOSE ORDERED",I)),$G(PSONEW("VERB",I))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="               Verb: "_$G(PSONEW("VERB",I))

 .S:$G(DS) IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (3)"

 K I,UNITS,ROUTE,DUR,COJ,VERB,NOUN,DG

 Q

DOSE3 I $G(DS)=1 S II=I,^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_"        *Dosage:" D FMD^PSOORFI3 G DO

 S II=I,IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="            *Dosage:" D FMD^PSOORFI3

DO I '$G(PSONEW("DOSE ORDERED",I)),$P($G(^PS(55,PSODFN,"LAN")),"^") S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" *Oth. Lang. Dosage: "_$G(PSONEW("ODOSE",I))

 I $G(PSONEW("DOSE ORDERED",I)),$G(PSONEW("VERB",I))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="               Verb: "_$G(PSONEW("VERB",I))

 I $G(PSONEW("DOSE ORDERED",I)) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="     Dispense Units: "_$S($E(PSONEW("DOSE ORDERED",I),1)=".":"0",1:"")_PSONEW("DOSE ORDERED",I)

 I $G(PSONEW("NOUN",I))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="               NOUN: "_PSONEW("NOUN",I)

 I $G(ROUTE)]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="             *Route: "_$G(ROUTE)

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="          *Schedule: "_PSONEW("SCHEDULE",I)

 I $G(PSONEW("DURATION",I))]"" D

 .S PSONEW("DURATION",I)=$S($E(PSONEW("DURATION",I),1)'?.N:$E(PSONEW("DURATION",I),2,99)_$E(PSONEW("DURATION",I),1),1:PSONEW("DURATION",I))

 .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="          *Duration: "_PSONEW("DURATION",I)_" ("_$S(PSONEW("DURATION",I)["M":"MINUTES",PSONEW("DURATION",I)["H":"HOURS",PSONEW("DURATION",I)["L":"MONTHS",PSONEW("DURATION",I)["W":"WEEKS",1:"DAYS")_")"

 I $G(PSONEW("CONJUNCTION",I))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="       *Conjunction: "_$S(PSONEW("CONJUNCTION",I)="T":"THEN",PSONEW("CONJUNCTION",I)="X":"EXCEPT",1:"AND")

 Q

OBX ;formats obx section

 N COM,II

 D:$G(PKI1) L1^PSOPKIV1

 I $O(^PS(52.41,ORD,"OBX",0)) S (T,IEN)=0,IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="Order Checks:" F  S T=$O(^PS(52.41,ORD,"OBX",T)) Q:'T  D  S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" "

 .S COM=$G(^PS(52.41,ORD,"OBX",T,0))

 .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="     " F II=1:1:$L(COM," ") D

 ..I $L(^TMP("PSOPO",$J,IEN,0)_" "_$P(COM," ",II))>80 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="     "

 ..S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_" "_$P(COM," ",II)

 .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="     Overriding Provider: "_$G(^PS(52.41,ORD,"OBX",T,1))

 .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="     Overriding Reason:"

 .F T1=0:0 S T1=$O(^PS(52.41,ORD,"OBX",T,2,T1)) Q:'T1  D

 ..S MIG=^PS(52.41,ORD,"OBX",T,2,T1,0)

 ..F SG=1:1:$L(MIG," ") S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(MIG," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",23)=" " S ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(MIG," ",SG)

 Q

PP S PSODFN=PAT D NOW^%DTC S TM=$E(%,1,12),TM1=$P(TM,".",2)

 Q

SPL K PSOFIN S POERR("QFLG")=0 S PSONOLCK=1,PSOPTLOK=PAT

 Q

CLQTY ;

 K PSONEW("QTY")

 D QTY^PSOSIG(.PSONEW)

 S:'$G(PSONEW("QTY")) PSONEW("QTY")=0

 Q

PQTY ;

 S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_", days supply of "_+$P(OR0,"^",22)_" and a qty of "_+$P(OR0,"^",10)

 Q

REF Q:$G(PSODRUG("DEA"))']""

 S CS=0 F DEA=1:1 Q:$E(PSODRUG("DEA"),DEA)=""  I $E(+PSODRUG("DEA"),DEA)>1,$E(+PSODRUG("DEA"),DEA)<6 S CS=1

 S PTRF=PSONEW("# OF REFILLS"),PSDAYS=PSONEW("DAYS SUPPLY")

 I CS D

 .S PSOX1=$S(PTRF>5:5,1:PTRF),PSOX=$S(PSOX1=5:5,1:PSOX1)

 .S PSOX=$S('PSOX:0,PSDAYS=90:1,1:PSOX),PSDY1=$S(PSDAYS<60:5,PSDAYS'<60&(PSDAYS'>89):2,PSDAYS=90:1,1:0)

 E  D

 .S PSOX1=PTRF,PSOX=$S(PSOX1=11:11,1:PSOX1),PSOX=$S('PSOX:0,PSDAYS=90:3,1:PSOX)

 .;IHS/MSC/PLS - 12/07/2012

 .;S PSDY1=$S(PSDAYS<60:11,PSDAYS'<60&(PSDAYS'>89):5,PSDAYS=90:3,1:0)

 .S PSDY1=$S(PSDAYS<60:15,PSDAYS<90:5,PSDAYS=90:3,PSDAYS<168:2,PSDAYS<365:1,1:0)

 S PSONEW("# OF REFILLS")=$S(PSONEW("# OF REFILLS")>PSDY1:PSDY1,1:PSONEW("# OF REFILLS"))

 Q

 ; IHS/CIA/PLS - 02/13/04

 ; Passes text in array through SIG expander

EXPPRC(PRC) ;

 N Z1,Z0,VALMSG,INS1,I,X,Y

 S I=0 F  S I=$O(PRC(I)) Q:'I  D

 .S X=PRC(I) I $E(X,1)=" " S X=$E(X,2,$L(X))

 .D SIGONE^PSOHELP

 .S PRC(I)=$G(INS1)

 Q

PSOORFI4  ;BIR/SAB-CPRS order checks and display con't ;07-Dec-2012 08:59;PLS

 +1       ;;7.0;OUTPATIENT PHARMACY;**46,74,78,99,117,131,1013,207,258,274,300,308,1015**;DEC 1997;Build 62

 +2       ;External reference to ^PS(51.2 supported by DBIA 2226

 +3       ;External reference to ^PS(50.607 supported by DBIA 2221

 +4       ;External reference ^PS(55 supported by DBIA 2228

 +5       ;External reference to ^PS(50.7 is supported by DBIA 2223

 +6       ;

 +7       ; Modified - IHS/CIA/PLS - 02/13/04 - Line PROVCOM+6 and new EXPPRC API

 +8       ;            IHS/MSC/PLS - 05/10/10 - Moved PROVCOM+6 change to PROVCOM+19

 +9       ;            IHS/MSC/PLS - 09/21/11 - Line OBX+2

 +10      ;                        - 09/28/11 - Line PROVCOM+2

 +11      ;                        - 12/07/12 - Line REF+8

ORCHK      DO ORCHK^PSOORNE6

 +1        QUIT 

INST      ;displays patient instructions

 +1        IF $ORDER(PSONEW("SIG",0))

               GOTO INST1

 +2        SET INST=0

           FOR 

               SET INST=$ORDER(^PS(52.41,ORD,"INS1",INST))

               IF 'INST

                   QUIT 

               SET (MIG,PSONEW("SIG",INST))=^PS(52.41,ORD,"INS1",INST,0)

               Begin DoDot:1

 +3                FOR SG=1:1:$LENGTH(MIG," ")

                       IF $LENGTH(^TMP("PSOPO",$JOB,IEN,0)_" "_$PIECE(MIG," ",SG))>80

                           SET IEN=IEN+1

                           SET $PIECE(^TMP("PSOPO",$JOB,IEN,0)," ",20)=" "

                       SET ^TMP("PSOPO",$JOB,IEN,0)=$GET(^TMP("PSOPO",$JOB,IEN,0))_" "_$PIECE(MIG," ",SG)

               End DoDot:1

 +4        IF $PIECE($GET(^PS(55,PSODFN,"LAN")),"^")

               IF $ORDER(^PS(52.41,ORD,"INS1",0))

                   Begin DoDot:1

 +5                    IF $GET(^PS(50.7,PSODRUG("OI"),"INS1"))]""

                           SET (X,PSONEW("SINS"))=^PS(50.7,PSODRUG("OI"),"INS1")

                           DO SSIG^PSOHELP

 +6                    IF $GET(SINS1)]""

                           SET PSONEW("SINS")=$EXTRACT(SINS1,2,250)

 +7                    SET IEN=IEN+1

                       SET ^TMP("PSOPO",$JOB,IEN,0)=" Other Pat Instruct: "_$SELECT($GET(PSONEW("SINS"))]"":PSONEW("SINS"),1:"")

                   End DoDot:1

 +8        KILL INST,TY,MIG,SG,SINS1

 +9        QUIT 

INST1     ;

 +1        SET INS=0

           FOR 

               SET INS=$ORDER(PSONEW("SIG",INS))

               IF 'INS

                   QUIT 

               SET MIG=PSONEW("SIG",INS)

               Begin DoDot:1

 +2                FOR SG=1:1:$LENGTH(MIG," ")

                       IF $LENGTH(^TMP("PSOPO",$JOB,IEN,0)_" "_$PIECE(MIG," ",SG))>80

                           SET IEN=IEN+1

                           SET $PIECE(^TMP("PSOPO",$JOB,IEN,0)," ",20)=" "

                       SET ^TMP("PSOPO",$JOB,IEN,0)=$GET(^TMP("PSOPO",$JOB,IEN,0))_" "_$PIECE(MIG," ",SG)

               End DoDot:1

 +3        KILL INST,TY,MIG,SG

 +4        IF $PIECE($GET(^PS(55,PSODFN,"LAN")),"^")

               SET IEN=IEN+1

               SET ^TMP("PSOPO",$JOB,IEN,0)=" Other Pat Instruct: "_$SELECT($GET(PSONEW("SINS"))]"":PSONEW("SINS"),1:"")

 +5        QUIT 

PROVCOM   ;

 +1        IF $GET(PKI1)=1

               IF '$GET(PSORX("VERIFY"))

                   DO REA^PSOPKIV1

                   IF $GET(PSORX("DFLG"))

                       QUIT 

 +2       ;IHS/MSC/PLS - 09/28/2011

 +3       ;I $O(PRC(0)),'$G(PSOPRC) D  D KV^PSOVER1

 +4        NEW APSPSARY

           MERGE APSPSARY=PSONEW("SIG")

 +5        IF $ORDER(PRC(0))

               IF '$GET(PSOPRC)

                   IF '$$SRCHARY^APSPFUNC(.APSPSARY,.PRC)

                       Begin DoDot:1

 +6                        DO EN^DDIOL("Provider Comments: ","","!")

 +7                        FOR I=0:0

                               SET I=$ORDER(PRC(I))

                               IF 'I

                                   QUIT 

                               DO EN^DDIOL(PRC(I),"","!")

 +8                        DO KV^PSOVER1

                           SET DIR(0)="Y"

                           SET DIR("A")="Copy Provider Comments into the Patient Instructions"

                           SET DIR("B")="No"

 +9                        DO ^DIR

                           IF 'Y!($DATA(DIRUT))

                               QUIT 

 +10      ;Check Provider Comments.  If any line contains more than 32

 +11      ;characters with no spaces, display error message and quit.

 +12      ;*308

 +13                       IF $$CHKCOM(.PRC)

                               Begin DoDot:2

 +14                               NEW X,Y,DIR,DIRUT,DUOUT,MSG

 +15                               SET MSG(1)="*** Provider Comments CANNOT be copied ***"

 +16                               SET MSG(1,"F")="!,$C(7)"

 +17                               SET MSG(2)="They contain a word longer than 32 characters, which is not allowed in"

 +18                               SET MSG(3)="the Patient Instructions.  You need to enter this manually."

 +19                               DO EN^DDIOL(.MSG)

 +20                               SET DIR(0)="E"

                                   SET DIR("A")="Press Return to continue"

                                   DO ^DIR

                               End DoDot:2

                               QUIT 

 +21                       SET PSOPRC=1

                           SET NI=0

                           FOR I=0:0

                               SET I=$ORDER(PSONEW("SIG",I))

                               IF 'I

                                   QUIT 

                               SET NI=I

 +22      ; IHS/CIA/PLS - 02/13/04 - Fix to expand provider comments

                           DO EXPPRC(.PRC)

 +23                       SET NC=0

                           FOR I=0:0

                               SET I=$ORDER(PRC(I))

                               IF 'I

                                   QUIT 

                               SET NC=NC+1

 +24                       IF NI'>1

                               IF NC=1

                                   IF ($LENGTH($GET(PSONEW("SIG",NI)))+$LENGTH(PRC(1)))'>250

                                       Begin DoDot:2

 +25                                       SET X=PRC(1)

                                           DO SIGONE^PSOHELP

 +26                                       SET PSONEW("SIG",1)=$GET(PSONEW("SIG",NI))_INS1

                                           KILL INS1,X

 +27                                       IF $EXTRACT(PSONEW("SIG",1))=" "

                                               SET PSONEW("SIG",1)=$EXTRACT(PSONEW("SIG",1),2,250)

                                           SET PSONEW("INS")=PSONEW("SIG",1)

                                           DO EN^PSOFSIG(.PSONEW,1)

                                           KILL NI,NC

                                       End DoDot:2

                                       QUIT 

 +28                       FOR I=0:0

                               SET I=$ORDER(PRC(I))

                               IF 'I

                                   QUIT 

                               SET NI=NI+1

                               SET (PSONEW("INS",NI),X)=PRC(I)

                               DO SIGONE^PSOHELP

                               SET PSONEW("SIG",NI)=INS1

                               KILL INS1

 +29                       IF $EXTRACT(PSONEW("SIG",1))=" "

                               SET PSONEW("SIG",1)=$EXTRACT(PSONEW("SIG",1),2,250)

 +30                       DO EN^PSOFSIG(.PSONEW,1)

                           KILL NI,NC,X

                       End DoDot:1

                       DO KV^PSOVER1

 +31       QUIT 

CHKCOM(PRC) ;Check provider comments array PRC. If any comment line is longer than 32 characters with no spaces, return 1

 +1       ;*308

 +2       ;INPUT:  PRC( = Provider Comments array

 +3       ;OUTPUT: PSOERR  = O - OK

 +4       ;                = 1 - Error (Comments > 32 chars. w/ no spaces)

 +5        NEW PSOX,PSOY,PSOZ,PSOERR

 +6        SET PSOERR=0

 +7        IF '$DATA(PRC)

               QUIT PSOERR

 +8        SET PSOX=0

 +9        FOR 

               SET PSOX=$ORDER(PRC(PSOX))

               IF PSOX=""!PSOERR

                   QUIT 

               IF $LENGTH(PRC(PSOX))>32

                   Begin DoDot:1

 +10                   SET PSOZ=$LENGTH(PRC(PSOX)," ")

                       FOR PSOY=1:1:PSOZ

                           IF $LENGTH($PIECE(PRC(PSOX)," ",PSOY))>32

                               SET PSOERR=1

                               QUIT 

                   End DoDot:1

 +11       QUIT PSOERR

DOSE      ;displays dosing info for pending orders.  called from psoorfi1

 +1        KILL II,UNITS

           SET DS=1

 +2        IF '$ORDER(^PS(52.41,ORD,1,0))

               SET IEN=IEN+1

               SET ^TMP("PSOPO",$JOB,IEN,0)=" (3)        *Dosage:"

               GOTO DOSEX

 +3        FOR I=0:0

               SET I=$ORDER(^PS(52.41,ORD,1,I))

               IF 'I

                   QUIT 

               SET DOSE=$GET(^PS(52.41,ORD,1,I,1))

               SET DOSE1=$GET(^(2))

               Begin DoDot:1

 +4                SET II=$GET(II)+1

                   KILL PSONEW("UNITS",II)

 +5                SET PSONEW("DOSE",II)=$PIECE(DOSE1,"^")

                   SET PSONEW("DOSE ORDERED",II)=$PIECE(DOSE1,"^",2)

                   SET PSONEW("UNITS",II)=$PIECE(DOSE,"^",9)

                   SET PSONEW("NOUN",II)=$PIECE(DOSE,"^",5)

 +6                IF $PIECE(DOSE,"^",9)

                       SET UNITS=$PIECE(^PS(50.607,$PIECE(DOSE,"^",9),0),"^")

 +7                SET PSONEW("VERB",II)=$PIECE(DOSE,"^",10)

                   SET PSONEW("ROUTE",II)=$PIECE(DOSE,"^",8)

 +8                IF $PIECE(DOSE,"^",8)

                       SET ROUTE=$PIECE(^PS(51.2,$PIECE(DOSE,"^",8),0),"^")

 +9                SET PSONEW("SCHEDULE",II)=$PIECE(DOSE,"^")

                   SET PSONEW("DURATION",II)=$PIECE(DOSE,"^",2)

 +10               SET DOENT=$GET(DOENT)+1

                   IF $PIECE(DOSE,"^",6)]""

                       SET PSONEW("CONJUNCTION",II)=$SELECT($PIECE(DOSE,"^",6)="S":"T",$PIECE(DOSE,"^",6)="X":"X",1:"A")

 +11               IF 'PSONEW("DOSE ORDERED",II)

                       IF $GET(PSONEW("VERB",II))]""

                           SET IEN=IEN+1

                           SET ^TMP("PSOPO",$JOB,IEN,0)="               Verb: "_$GET(PSONEW("VERB",II))

 +12               IF $GET(DS)

                       SET IEN=IEN+1

                       SET ^TMP("PSOPO",$JOB,IEN,0)=" (3)"

               End DoDot:1

               DO DOSE1

DOSEX      SET PSONEW("ENT")=+$GET(II)

           KILL DOSE,DOSE1,II,I,UNITS,ROUTE,DG

 +1        QUIT 

DOSE1      IF $GET(DS)=1

               SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_"        *Dosage:"

               DO FMD^PSOORFI3

               GOTO DU

 +1        SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)="            *Dosage:"

           DO FMD^PSOORFI3

DU         IF 'PSONEW("DOSE ORDERED",I)

               IF $PIECE($GET(^PS(55,PSODFN,"LAN")),"^")

                   SET IEN=IEN+1

                   SET ^TMP("PSOPO",$JOB,IEN,0)=" *Oth. Lang. Dosage: "_$GET(PSONEW("ODOSE",I))

 +1        IF PSONEW("DOSE ORDERED",II)

               IF $GET(PSONEW("VERB",II))]""

                   Begin DoDot:1

 +2                    SET IEN=IEN+1

                       SET ^TMP("PSOPO",$JOB,IEN,0)="               Verb: "_$GET(PSONEW("VERB",II))

 +3                    SET IEN=IEN+1

                       SET ^TMP("PSOPO",$JOB,IEN,0)="     Dispense Units: "_$SELECT($EXTRACT(PSONEW("DOSE ORDERED",II),1)=".":"0",1:"")_PSONEW("DOSE ORDERED",II)

                   End DoDot:1

 +4        IF PSONEW("NOUN",II)]""

               SET IEN=IEN+1

               SET ^TMP("PSOPO",$JOB,IEN,0)="               Noun: "_PSONEW("NOUN",II)

 +5        IF $GET(ROUTE)]""

               SET IEN=IEN+1

               SET ^TMP("PSOPO",$JOB,IEN,0)="             *Route: "_$GET(ROUTE)

 +6        SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)="          *Schedule: "_PSONEW("SCHEDULE",II)

 +7        IF $GET(PSONEW("DURATION",II))]""

               Begin DoDot:1

 +8                SET PSONEW("DURATION",II)=$SELECT($EXTRACT(PSONEW("DURATION",II),1)'?.N:$EXTRACT(PSONEW("DURATION",II),2,99)_$EXTRACT(PSONEW("DURATION",II),1),1:PSONEW("DURATION",II))

 +9                SET IEN=IEN+1

                   SET ^TMP("PSOPO",$JOB,IEN,0)="          *Duration: "_PSONEW("DURATION",II)_" ("_$SELECT(PSONEW("DURATION",II)["M":"MINUTES",PSONEW("DURATION",II)["H":"HOURS",PSONEW("DURATION",II)["L":"MONTHS",PSONEW("DURATION",II)["W":"WEEKS",1:"DAYS")

_")"

               End DoDot:1

 +10       IF $GET(PSONEW("CONJUNCTION",II))]""

               SET IEN=IEN+1

               SET ^TMP("PSOPO",$JOB,IEN,0)="       *Conjunction: "_$SELECT(PSONEW("CONJUNCTION",II)="T":"THEN",PSONEW("CONJUNCTION",II)="X":"EXCEPT",1:"AND")

 +11       QUIT 

DOSE2     ;displays pending order after edits.  called from psoornew

 +1        IF '$ORDER(PSONEW("DOSE",0))!($ORDER(PSONEW("DOSE",0))="")

               SET IEN=IEN+1

               SET ^TMP("PSOPO",$JOB,IEN,0)=" (3)        *Dosage:"

               QUIT 

 +2        SET DS=1

 +3        FOR I=1:1:PSONEW("ENT")

               IF 'I

                   QUIT 

               Begin DoDot:1

 +4                IF $GET(PSONEW("UNITS",I))]""

                       SET UNITS=$PIECE(^PS(50.607,PSONEW("UNITS",I),0),"^")

 +5                IF $GET(PSONEW("ROUTE",I))]""