PSOORFI4 ;BIR/SAB - CPRS order checks and display con't ;Aug 23, 2021@14:15:33
;;7.0;OUTPATIENT PHARMACY;**46,74,78,99,117,131,207,258,274,300,308,251,384,391,444,441,700**;DEC 1997;Build 261
;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
;
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 ;
N MBMSITE
S MBMSITE=$S($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
I 'MBMSITE,$O(PRC(0)),'$G(PSOPRC) 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
.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 ROUTE="" 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
S IEN=0
D:$G(PKI1) L1^PSOPKIV1
I $O(^PS(52.41,ORD,"OBX",0)) S T=0,IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="CPRS 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))
.I $O(^PS(52.41,ORD,"OBX",T,2,0)) 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
;
IND ;
Q:'$D(PSONEW("IND"))
Q:$D(PSONEW("INDF"))
D EN^DDIOL("Indication: "_PSONEW("IND"),"","!!")
N X,Y,DIR,DIRUT,DUOUT,PSOZ S PSOZ=$$GET1^DIQ(59.7,1,96),DIR(0)="Y",DIR("A")="Copy Indication into the Sig",DIR("B")=$S(PSOZ]"":PSOZ,1:"YES")
D ^DIR Q:'Y!($D(DIRUT))
S PSONEW("INDF")=1 D EN^PSOFSIG(.PSONEW,1)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOORFI4 10305 printed Jan 18, 2025@03:33:10 Page 2
PSOORFI4 ;BIR/SAB - CPRS order checks and display con't ;Aug 23, 2021@14:15:33
+1 ;;7.0;OUTPATIENT PHARMACY;**46,74,78,99,117,131,207,258,274,300,308,251,384,391,444,441,700**;DEC 1997;Build 261
+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 ;
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 NEW MBMSITE
+2 SET MBMSITE=$SELECT($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
+3 IF 'MBMSITE
IF $ORDER(PRC(0))
IF '$GET(PSOPRC)
Begin DoDot:1
+4 DO EN^DDIOL("Provider Comments: ","","!")
+5 FOR I=0:0
SET I=$ORDER(PRC(I))
if 'I
QUIT
DO EN^DDIOL(PRC(I),"","!")
+6 DO KV^PSOVER1
SET DIR(0)="Y"
SET DIR("A")="Copy Provider Comments into the Patient Instructions"
SET DIR("B")="No"
+7 DO ^DIR
if 'Y!($DATA(DIRUT))
QUIT
+8 ;Check Provider Comments. If any line contains more than 32
+9 ;characters with no spaces, display error message and quit.
+10 ;*308
+11 IF $$CHKCOM(.PRC)
Begin DoDot:2
+12 NEW X,Y,DIR,DIRUT,DUOUT,MSG
+13 SET MSG(1)="*** Provider Comments CANNOT be copied ***"
+14 SET MSG(1,"F")="!,$C(7)"
+15 SET MSG(2)="They contain a word longer than 32 characters, which is not allowed in"
+16 SET MSG(3)="the Patient Instructions. You need to enter this manually."
+17 DO EN^DDIOL(.MSG)
+18 SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
End DoDot:2
QUIT
+19 SET PSOPRC=1
SET NI=0
FOR I=0:0
SET I=$ORDER(PSONEW("SIG",I))
if 'I
QUIT
SET NI=I
+20 SET NC=0
FOR I=0:0
SET I=$ORDER(PRC(I))
if 'I
QUIT
SET NC=NC+1
+21 IF NI'>1
IF NC=1
IF ($LENGTH($GET(PSONEW("SIG",NI)))+$LENGTH(PRC(1)))'>250
Begin DoDot:2
+22 SET X=PRC(1)
DO SIGONE^PSOHELP
+23 SET PSONEW("SIG",1)=$GET(PSONEW("SIG",NI))_INS1
KILL INS1,X
+24 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
+25 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
+26 IF $EXTRACT(PSONEW("SIG",1))=" "
SET PSONEW("SIG",1)=$EXTRACT(PSONEW("SIG",1),2,250)
+27 DO EN^PSOFSIG(.PSONEW,1)
KILL NI,NC,X
End DoDot:1
DO KV^PSOVER1
+28 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 SET ROUTE=""
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 SET IEN=0
+3 if $GET(PKI1)
DO L1^PSOPKIV1
+4 IF $ORDER(^PS(52.41,ORD,"OBX",0))
SET T=0
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)="CPRS Order Checks:"
FOR
SET T=$ORDER(^PS(52.41,ORD,"OBX",T))
if 'T
QUIT
Begin DoDot:1
+5 SET COM=$GET(^PS(52.41,ORD,"OBX",T,0))
+6 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" "
FOR II=1:1:$LENGTH(COM," ")
Begin DoDot:2
+7 IF $LENGTH(^TMP("PSOPO",$JOB,IEN,0)_" "_$PIECE(COM," ",II))>80
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" "
+8 SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_" "_$PIECE(COM," ",II)
End DoDot:2
+9 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Overriding Provider: "_$GET(^PS(52.41,ORD,"OBX",T,1))
+10 IF $ORDER(^PS(52.41,ORD,"OBX",T,2,0))
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Overriding Reason:"
+11 FOR T1=0:0
SET T1=$ORDER(^PS(52.41,ORD,"OBX",T,2,T1))
if 'T1
QUIT
Begin DoDot:2
+12 SET MIG=^PS(52.41,ORD,"OBX",T,2,T1,0)
+13 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)=" "
+14 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
+3 ;
IND ;
+1 if '$DATA(PSONEW("IND"))
QUIT
+2 if $DATA(PSONEW("INDF"))
QUIT
+3 DO EN^DDIOL("Indication: "_PSONEW("IND"),"","!!")
+4 NEW X,Y,DIR,DIRUT,DUOUT,PSOZ
SET PSOZ=$$GET1^DIQ(59.7,1,96)
SET DIR(0)="Y"
SET DIR("A")="Copy Indication into the Sig"
SET DIR("B")=$SELECT(PSOZ]"":PSOZ,1:"YES")
+5 DO ^DIR
if 'Y!($DATA(DIRUT))
QUIT
+6 SET PSONEW("INDF")=1
DO EN^PSOFSIG(.PSONEW,1)
+7 QUIT
+8 ;
