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))]""
IF $GET(^PS(51.2,PSONEW("ROUTE",I),0))]""
SET ROUTE=$PIECE(^PS(51.2,PSONEW("ROUTE",I),0),"^")
+6 SET DUR=$GET(PSONEW("DURATION",I))
IF $GET(PSONEW("CONJUNCTION",I))]""
SET COJ=PSONEW("CONJUNCTION",I)
+7 SET NOUN=$GET(PSONEW("NOUN",I))
SET VERB=$GET(PSONEW("VERB",I))
+8 IF '$GET(PSONEW("DOSE ORDERED",I))
IF $GET(PSONEW("VERB",I))]""
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Verb: "_$GET(PSONEW("VERB",I))
+9 IF $GET(DS)
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" (3)"
End DoDot:1
DO DOSE3
KILL COJ
+10 KILL I,UNITS,ROUTE,DUR,COJ,VERB,NOUN,DG
+11 QUIT
DOSE3 IF $GET(DS)=1
SET II=I
SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_" *Dosage:"
DO FMD^PSOORFI3
GOTO DO
+1 SET II=I
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" *Dosage:"
DO FMD^PSOORFI3
DO IF '$GET(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 $GET(PSONEW("DOSE ORDERED",I))
IF $GET(PSONEW("VERB",I))]""
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Verb: "_$GET(PSONEW("VERB",I))
+2 IF $GET(PSONEW("DOSE ORDERED",I))
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Dispense Units: "_$SELECT($EXTRACT(PSONEW("DOSE ORDERED",I),1)=".":"0",1:"")_PSONEW("DOSE ORDERED",I)
+3 IF $GET(PSONEW("NOUN",I))]""
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" NOUN: "_PSONEW("NOUN",I)
+4 IF $GET(ROUTE)]""
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" *Route: "_$GET(ROUTE)
+5 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" *Schedule: "_PSONEW("SCHEDULE",I)
+6 IF $GET(PSONEW("DURATION",I))]""
Begin DoDot:1
+7 SET PSONEW("DURATION",I)=$SELECT($EXTRACT(PSONEW("DURATION",I),1)'?.N:$EXTRACT(PSONEW("DURATION",I),2,99)_$EXTRACT(PSONEW("DURATION",I),1),1:PSONEW("DURATION",I))
+8 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" *Duration: "_PSONEW("DURATION",I)_" ("_$SELECT(PSONEW("DURATION",I)["M":"MINUTES",PSONEW("DURATION",I)["H":"HOURS",PSONEW("DURATION",I)["L":"MONTHS",PSONEW("DURATION",I)["W":"WEEKS",1:"DAYS")_")"
End DoDot:1
+9 IF $GET(PSONEW("CONJUNCTION",I))]""
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" *Conjunction: "_$SELECT(PSONEW("CONJUNCTION",I)="T":"THEN",PSONEW("CONJUNCTION",I)="X":"EXCEPT",1:"AND")
+10 QUIT
OBX ;formats obx section
+1 NEW COM,II
+2 IF $GET(PKI1)
DO L1^PSOPKIV1
+3 IF $ORDER(^PS(52.41,ORD,"OBX",0))
SET (T,IEN)=0
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)="Order Checks:"
FOR
SET T=$ORDER(^PS(52.41,ORD,"OBX",T))
IF 'T
QUIT
Begin DoDot:1
+4 SET COM=$GET(^PS(52.41,ORD,"OBX",T,0))
+5 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" "
FOR II=1:1:$LENGTH(COM," ")
Begin DoDot:2
+6 IF $LENGTH(^TMP("PSOPO",$JOB,IEN,0)_" "_$PIECE(COM," ",II))>80
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" "
+7 SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_" "_$PIECE(COM," ",II)
End DoDot:2
+8 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Overriding Provider: "_$GET(^PS(52.41,ORD,"OBX",T,1))
+9 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Overriding Reason:"
+10 FOR T1=0:0
SET T1=$ORDER(^PS(52.41,ORD,"OBX",T,2,T1))
IF 'T1
QUIT
Begin DoDot:2
+11 SET MIG=^PS(52.41,ORD,"OBX",T,2,T1,0)
+12 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)," ",23)=" "
SET ^TMP("PSOPO",$JOB,IEN,0)=$GET(^TMP("PSOPO",$JOB,IEN,0))_" "_$PIECE(MIG," ",SG)
End DoDot:2
End DoDot:1
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" "
+13 QUIT
PP SET PSODFN=PAT
DO NOW^%DTC
SET TM=$EXTRACT(%,1,12)
SET TM1=$PIECE(TM,".",2)
+1 QUIT
SPL KILL PSOFIN
SET POERR("QFLG")=0
SET PSONOLCK=1
SET PSOPTLOK=PAT
+1 QUIT
CLQTY ;
+1 KILL PSONEW("QTY")
+2 DO QTY^PSOSIG(.PSONEW)
+3 IF '$GET(PSONEW("QTY"))
SET PSONEW("QTY")=0
+4 QUIT
PQTY ;
+1 SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_", days supply of "_+$PIECE(OR0,"^",22)_" and a qty of "_+$PIECE(OR0,"^",10)
+2 QUIT
REF IF $GET(PSODRUG("DEA"))']""
QUIT
+1 SET CS=0
FOR DEA=1:1
IF $EXTRACT(PSODRUG("DEA"),DEA)=""
QUIT
IF $EXTRACT(+PSODRUG("DEA"),DEA)>1
IF $EXTRACT(+PSODRUG("DEA"),DEA)<6
SET CS=1
+2 SET PTRF=PSONEW("# OF REFILLS")
SET PSDAYS=PSONEW("DAYS SUPPLY")
+3 IF CS
Begin DoDot:1
+4 SET PSOX1=$SELECT(PTRF>5:5,1:PTRF)
SET PSOX=$SELECT(PSOX1=5:5,1:PSOX1)
+5 SET PSOX=$SELECT('PSOX:0,PSDAYS=90:1,1:PSOX)
SET PSDY1=$SELECT(PSDAYS<60:5,PSDAYS'<60&(PSDAYS'>89):2,PSDAYS=90:1,1:0)
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 SET PSOX1=PTRF
SET PSOX=$SELECT(PSOX1=11:11,1:PSOX1)
SET PSOX=$SELECT('PSOX:0,PSDAYS=90:3,1:PSOX)
+8 ;IHS/MSC/PLS - 12/07/2012
+9 ;S PSDY1=$S(PSDAYS<60:11,PSDAYS'<60&(PSDAYS'>89):5,PSDAYS=90:3,1:0)
+10 SET PSDY1=$SELECT(PSDAYS<60:15,PSDAYS<90:5,PSDAYS=90:3,PSDAYS<168:2,PSDAYS<365:1,1:0)
End DoDot:1
+11 SET PSONEW("# OF REFILLS")=$SELECT(PSONEW("# OF REFILLS")>PSDY1:PSDY1,1:PSONEW("# OF REFILLS"))
+12 QUIT
+13 ; IHS/CIA/PLS - 02/13/04
+14 ; Passes text in array through SIG expander
EXPPRC(PRC) ;
+1 NEW Z1,Z0,VALMSG,INS1,I,X,Y
+2 SET I=0
FOR
SET I=$ORDER(PRC(I))
IF 'I
QUIT
Begin DoDot:1
+3 SET X=PRC(I)
IF $EXTRACT(X,1)=" "
SET X=$EXTRACT(X,2,$LENGTH(X))
+4 DO SIGONE^PSOHELP
+5 SET PRC(I)=$GET(INS1)
End DoDot:1
+6 QUIT
