PSJBCMA2 ;BIR/MV - RETURN INPATIENT ACTIVITY LOG ;16 Mar 99 / 11:43 AM
;;5.0;INPATIENT MEDICATIONS;**32,41,54,56,81,267,370,397,419**;16 DEC 97;Build 10
;
;Reference to ^PS(55 is supported by DBIA 2191
;
EN(DFN,ON,PSJTMP) ;
NEW X,Y
S PSJINX=0
S PSJTMP=$S($G(PSJTMP)=1:"PSJ2",1:"PSJ")
I $G(ON)["U",$D(^PS(55,+$G(DFN),5,+ON)) D UD
I $G(ON)["V",$D(^PS(55,+$G(DFN),"IV",+ON)) D IV
I '$D(^TMP(PSJTMP,$J,0)) S ^(0)=-1
K PSJINX
Q
UD ;Get Activity Log for Unit Dose order.
N PSJVFDTM
F PSJAL=0:0 S PSJAL=$O(^PS(55,DFN,5,+ON,9,PSJAL)) Q:'PSJAL D
. S X=$G(^PS(55,DFN,5,+ON,9,PSJAL,0))
. S PSJ("DATE")=$P(X,U)
. S (PSJ("USER"),PSJ("UIEN"))=$P(X,U,2),PSJ("FIELD")=$P(X,U,4)
. S PSJ("OLD DATA")=$P(X,U,5)
. S PSJ("ACTION")=$P($G(^PS(53.3,+$P(X,U,3),0)),U)
. I PSJ("ACTION")="VERIFIED BY PHARMACIST" S PSJVFDTM=PSJ("DATE")
. I PSJ("FIELD")="SPECIAL INSTRUCTIONS",PSJ("ACTION")="EDITED" Q:PSJ("DATE")=$G(PSJVFDTM)
. D TMP K PSJ
K PSJAL
Q
IV ;Get Activity Log for IV order.
F PSJAL=0:0 S PSJAL=$O(^PS(55,DFN,"IV",+ON,"A",PSJAL)) Q:'PSJAL D
. K PSJ,PSJDD
. S X=$G(^PS(55,DFN,"IV",+ON,"A",PSJAL,0))
. S PSJ("DATE")=$P(X,U,5)
. S PSJ("ACTION")=$P(X,U,2) Q:PSJ("ACTION")="F"
. S PSJ("USER")=$P(X,U,3)
. S PSJ("REASON")=$P(X,U,4)
. S PSJ("ACTION")=$$CODES^PSIVUTL(PSJ("ACTION"),55.04,.02)
. S PSJ("UIEN")=$P(X,U,6)
. I PSJAL=1,($G(^PS(55,DFN,"IV",+ON,"A",PSJAL,1,1,0))["OTHER PRINT INFO") Q
. I $O(^PS(55,DFN,"IV",+ON,"A",PSJAL,1,0))="" D TMP
. F PSJFC=0:0 S PSJFC=$O(^PS(55,DFN,"IV",+ON,"A",PSJAL,1,PSJFC)) Q:'PSJFC D
.. S X=$G(^PS(55,DFN,"IV",+ON,"A",PSJAL,1,PSJFC,0))
.. K PSJ("FIELD"),PSJ("OLD DATA")
.. S PSJ("FIELD")=$P(X,U)
.. S PSJ("OLD DATA")=$P(X,U,2)
.. D TMP
K PSJ,PSJAL,PSJFC
Q
TMP ;Setup ^TMP
S PSJINX=PSJINX+1
I +PSJ("USER") D NAME^PSJBCMA1(+PSJ("USER"),.X,"") S PSJ("USER")=X
S ^TMP(PSJTMP,$J,0)=DFN_U_+ON_U_ON_U_PSJINX
S ^TMP(PSJTMP,$J,PSJINX,1)=PSJ("DATE")_U_PSJ("USER")_U_$G(PSJ("FIELD"))_U_PSJ("ACTION")_U_$G(PSJ("UIEN"))
S:$G(PSJ("OLD DATA"))]"" ^TMP(PSJTMP,$J,PSJINX,2)=PSJ("OLD DATA")
S:$G(PSJ("REASON"))]"" ^TMP(PSJTMP,$J,PSJINX,3)=PSJ("REASON")
Q
GETFLD ;
N X D FIELD^DID(55.04,.02,"","POINTER","PSJDD") Q
Q
;
FILESI(DFN,PSJORD) ; File special instructions
I PSJORD["U" S LN=0 D
.I $G(PSGOEENO)&($G(PSGORD)=$G(PSJORD)) Q
.K ^PS(55,DFN,5,+PSJORD,15) I ($G(^PS(53.45,+$G(PSJSYSP),5,0))<0) S ^PS(55,DFN,5,+PSJORD,6)="" Q
.I '$D(^PS(55,DFN,5,+PSJORD,15,1,0)),($O(^PS(53.45,+$G(PSJSYSP),5," "),-1)=1) Q:($TR(^PS(53.45,PSJSYSP,5,1,0)," ")="")
.S LNCNT=0,LN=9999 F S LN=$O(^PS(53.45,+$G(PSJSYSP),5,LN),-1) Q:'LN D
..I 'LNCNT,($G(^PS(53.45,+$G(PSJSYSP),5,LN,0))="") Q
..I $D(^PS(53.45,+$G(PSJSYSP),5,LN,0)) S ^PS(55,+DFN,5,+PSJORD,15,LN,0)=^PS(53.45,+$G(PSJSYSP),5,LN,0) S LNCNT=LNCNT+1
.I $G(LNCNT) S ^PS(55,+DFN,5,+PSJORD,15,0)="^55.6135^"_+LNCNT_"^"_+LNCNT D
..N TXT,SIMSG S SIMSG="Instructions too long. See Order View or BCMA for full text."
..S PSJTMPTX="",PSJOVRMX=0 S TMPLIN=0 F S TMPLIN=$O(^PS(55,+DFN,5,+PSJORD,15,TMPLIN)) Q:'TMPLIN!(PSJOVRMX) D
...S:($L(PSJTMPTX)+$L($G(^PS(55,+DFN,5,+PSJORD,15,TMPLIN,0))))>180 PSJOVRMX=1 Q:$G(PSJOVRMX) S PSJTMPTX=$G(PSJTMPTX)_$S($G(PSJTMPTX)]"":" ",1:"")_$G(^PS(55,+DFN,5,+PSJORD,15,TMPLIN,0))
..S TXT=$S($G(PSJOVRMX):SIMSG,1:PSJTMPTX)
..I $G(DFN) I $D(^PS(55,DFN,5,+PSJORD,0)) S ^PS(55,DFN,5,+PSJORD,6)=TXT_"^"_$S($G(PSGSIF):1,1:"")
.N LSTLNUM,LSTLNTXT S LSTLNUM=$O(^PS(55,+DFN,5,+PSJORD,15,""),-1) I LSTLNUM>1 S LSTLNTXT=$G(^PS(55,+DFN,5,+PSJORD,15,LSTLNUM,0)) I $TR(LSTLNTXT," ")="" D
..K ^PS(55,+DFN,5,+PSJORD,15,LSTLNUM,0)
I PSJORD["P" S LN=0 D
.N PSGSIF S PSGSIF=+$P($G(^PS(53.1,+PSJORD,6)),"^",2)
.I $G(PSGOEENO)'=1 K ^PS(53.1,+PSJORD,15)
.I ($G(^PS(53.45,+$G(PSJSYSP),5,0))<0) S ^PS(53.1,+PSJORD,6)="",^PS(53.1,+PSJORD,15,0)="^53.1135^0^0" Q
.I '$D(^PS(53.1,+PSJORD,15,1,0)),($O(^PS(53.45,+$G(PSJSYSP),5," "),-1)=1) Q:($TR(^PS(53.45,PSJSYSP,5,1,0)," ")="")
.S LNCNT=0,LN=9999 F S LN=$O(^PS(53.45,+$G(PSJSYSP),5,LN),-1) Q:'LN D
..I 'LNCNT,($G(^PS(53.45,+$G(PSJSYSP),5,LN,0))="") Q
..I $D(^PS(53.45,+$G(PSJSYSP),5,LN,0)) S ^PS(53.1,+PSJORD,15,LN,0)=^PS(53.45,+$G(PSJSYSP),5,LN,0) S LNCNT=LNCNT+1
.I $G(LNCNT) S ^PS(53.1,+PSJORD,15,0)="^53.1135^"_+LNCNT_"^"_+LNCNT D
..N TXT,SIMSG S SIMSG="Instructions too long. See Order View or BCMA for full text."
..S PSJTMPTX="",PSJOVRMX=0 S TMPLIN=0 F S TMPLIN=$O(^PS(53.1,+PSJORD,15,TMPLIN)) Q:'TMPLIN!(PSJOVRMX) D
...S:($L(PSJTMPTX)+$L($G(^PS(53.1,+PSJORD,15,TMPLIN,0))))>180 PSJOVRMX=1 Q:$G(PSJOVRMX) S PSJTMPTX=$G(PSJTMPTX)_$S($G(PSJTMPTX)]"":" ",1:"")_$G(^PS(53.1,+PSJORD,15,TMPLIN,0))
..S TXT=$S($G(PSJOVRMX):SIMSG,1:PSJTMPTX)
..I $D(^PS(53.1,+$G(PSJORD),0)) S ^PS(53.1,+PSJORD,6)=TXT_"^"_$S($G(PSGSIF):1,1:"")
.N LSTLNUM,LSTLNTXT S LSTLNUM=$O(^PS(53.1,+PSJORD,15,""),-1) I LSTLNUM>1 S LSTLNTXT=$G(^PS(53.1,+PSJORD,15,LSTLNUM,0)) I $TR(LSTLNTXT," ")="" D
..K ^PS(53.1,+PSJORD,15,LSTLNUM,0)
Q
FILEOPI(DFN,ORDER) ; File other print info
I PSJORD["V" S LN=0 D
.D LOGOPI^PSIVORFB(DFN,ORDER)
.K ^PS(55,+DFN,"IV",+PSJORD,10) S ^PS(55,+DFN,"IV",+PSJORD,3)="" I '$D(^PS(53.45,+$G(PSJSYSP),6,2,0))&(($G(^PS(53.45,+$G(PSJSYSP),6,1,0))=-1)!($G(^PS(53.45,+$G(PSJSYSP),6,0))=-1)) D Q
..S ^PS(55,+DFN,"IV",+PSJORD,10,0)="^55.1154^1^1",^PS(55,+DFN,"IV",PSJORD,10,1,0)=""
.I '$D(^PS(55,DFN,"IV",+PSJORD,10,1,0)),($O(^PS(53.45,+$G(PSJSYSP),6," "),-1)=1) I ($TR(^PS(53.45,PSJSYSP,6,1,0)," ")="") D Q
..S ^PS(55,+DFN,"IV",+PSJORD,10,0)="^55.1154^1^1",^PS(55,+DFN,"IV",+PSJORD,10,1,0)=""
.S LNCNT=0,LN=9999 F S LN=$O(^PS(53.45,+$G(PSJSYSP),6,LN),-1) Q:'LN D
..I 'LNCNT,($G(^PS(53.45,+$G(PSJSYSP),6,LN,0))="") Q
..I $D(^PS(53.45,+$G(PSJSYSP),6,LN,0)) S ^PS(55,+DFN,"IV",+PSJORD,10,LN,0)=^PS(53.45,+$G(PSJSYSP),6,LN,0) S LNCNT=LNCNT+1
.I LNCNT S ^PS(55,+DFN,"IV",+PSJORD,10,0)="^55.1154^"_+LNCNT_"^"_+LNCNT D
..N TXT,DIE,DA,OPIMSG S OPIMSG="Instructions too long. See Order View or BCMA for full text."
..S PSJTMPTX="",PSJOVRMX=0 S TMPLIN=0 F S TMPLIN=$O(^PS(55,+DFN,"IV",+PSJORD,10,TMPLIN)) Q:'TMPLIN!(PSJOVRMX) D
...S:($L(PSJTMPTX)+$L($G(^PS(55,DFN,"IV",+PSJORD,10,TMPLIN,0))))>60 PSJOVRMX=1 Q:$G(PSJOVRMX) S PSJTMPTX=$G(PSJTMPTX)_$S($G(PSJTMPTX)]"":" ",1:"")_$G(^PS(55,DFN,"IV",+PSJORD,10,TMPLIN,0))
..S TXT=$S($G(PSJOVRMX):OPIMSG,1:$G(PSJTMPTX))
..I $TR(TXT,"^ ")="" S ^PS(55,DFN,"IV",+PSJORD,3)="" Q
..S ^PS(55,DFN,"IV",+PSJORD,3)=TXT_"^"_$P($G(P("OPI")),"^",2)
I PSJORD["P" D
.I $D(^PS(53.1,+PSJORD,16)),$$DIFFOPI^PSJBCMA5(DFN,PSJORD) D
..N SIARRAY,PSJALORD M SIARRAY=^PS(53.1,+PSJORD,16),PSJALORD=PSJORD I '$D(SIARRAY) S SIARRAY(0)="^^1^1",SIARRAY(1,0)=" "
..D NEWNVAL^PSGAL5(PSJORD,6000,"OTHER PRINT INFO",,.SIARRAY)
.K ^PS(53.1,+PSJORD,16) I ('$D(^PS(53.45,+$G(PSJSYSP),6,2,0))&($TR($G(^PS(53.45,+$G(PSJSYSP),6,1,0)),"^ ")=""))!+($G(^PS(53.45,+$G(PSJSYSP),6,0))=-1) D Q
..S ^PS(53.1,+PSJORD,9)="",^PS(53.1,+PSJORD,16,0)="^53.1136^1^1",^PS(53.1,+PSJORD,16,1,0)=""
.I '$D(^PS(53.1,+PSJORD,16,1,0)),($O(^PS(53.45,+$G(PSJSYSP),6," "),-1)=1) I ($TR(^PS(53.45,PSJSYSP,6,1,0)," ")="") D Q
..S ^PS(53.1,+PSJORD,9)="",^PS(53.1,+PSJORD,16,0)="^53.1136^1^1",^PS(53.1,+PSJORD,16,1,0)=""
.S LNCNT=0,LN=9999 F S LN=$O(^PS(53.45,+PSJSYSP,6,LN),-1) Q:'LN D
..I 'LNCNT,($G(^PS(53.45,+PSJSYSP,6,LN,0))="") Q
..I $D(^PS(53.45,+PSJSYSP,6,LN,0)) S ^PS(53.1,+PSJORD,16,LN,0)=^PS(53.45,+PSJSYSP,6,LN,0) S LNCNT=LNCNT+1
.I $G(LNCNT) S ^PS(53.1,+PSJORD,16,0)="^53.1136^"_+LNCNT_"^"_+LNCNT D
..N TXT,DIE,DA,OPIMSG S OPIMSG="Instructions too long. See Order View or BCMA for full text."
..S PSJTMPTX="",PSJOVRMX=0 S TMPLIN=0 F S TMPLIN=$O(^PS(53.1,+PSJORD,16,TMPLIN)) Q:'TMPLIN!(PSJOVRMX) D
...S:($L(PSJTMPTX)+$L($G(^PS(53.1,+PSJORD,16,TMPLIN,0))))>60 PSJOVRMX=1 Q:$G(PSJOVRMX) S PSJTMPTX=$G(PSJTMPTX)_$S($G(PSJTMPTX)]"":" ",1:"")_$G(^PS(53.1,+PSJORD,16,TMPLIN,0))
..S TXT=$S($G(PSJOVRMX):OPIMSG,1:$G(PSJTMPTX))
..S $P(^PS(53.1,+PSJORD,9),"^",2)=TXT,$P(^PS(53.1,+PSJORD,9),"^",3)=$P($G(P("OPI")),"^",2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJBCMA2 8041 printed Jan 18, 2025@03:07:29 Page 2
PSJBCMA2 ;BIR/MV - RETURN INPATIENT ACTIVITY LOG ;16 Mar 99 / 11:43 AM
+1 ;;5.0;INPATIENT MEDICATIONS;**32,41,54,56,81,267,370,397,419**;16 DEC 97;Build 10
+2 ;
+3 ;Reference to ^PS(55 is supported by DBIA 2191
+4 ;
EN(DFN,ON,PSJTMP) ;
+1 NEW X,Y
+2 SET PSJINX=0
+3 SET PSJTMP=$SELECT($GET(PSJTMP)=1:"PSJ2",1:"PSJ")
+4 IF $GET(ON)["U"
IF $DATA(^PS(55,+$GET(DFN),5,+ON))
DO UD
+5 IF $GET(ON)["V"
IF $DATA(^PS(55,+$GET(DFN),"IV",+ON))
DO IV
+6 IF '$DATA(^TMP(PSJTMP,$JOB,0))
SET ^(0)=-1
+7 KILL PSJINX
+8 QUIT
UD ;Get Activity Log for Unit Dose order.
+1 NEW PSJVFDTM
+2 FOR PSJAL=0:0
SET PSJAL=$ORDER(^PS(55,DFN,5,+ON,9,PSJAL))
if 'PSJAL
QUIT
Begin DoDot:1
+3 SET X=$GET(^PS(55,DFN,5,+ON,9,PSJAL,0))
+4 SET PSJ("DATE")=$PIECE(X,U)
+5 SET (PSJ("USER"),PSJ("UIEN"))=$PIECE(X,U,2)
SET PSJ("FIELD")=$PIECE(X,U,4)
+6 SET PSJ("OLD DATA")=$PIECE(X,U,5)
+7 SET PSJ("ACTION")=$PIECE($GET(^PS(53.3,+$PIECE(X,U,3),0)),U)
+8 IF PSJ("ACTION")="VERIFIED BY PHARMACIST"
SET PSJVFDTM=PSJ("DATE")
+9 IF PSJ("FIELD")="SPECIAL INSTRUCTIONS"
IF PSJ("ACTION")="EDITED"
if PSJ("DATE")=$GET(PSJVFDTM)
QUIT
+10 DO TMP
KILL PSJ
End DoDot:1
+11 KILL PSJAL
+12 QUIT
IV ;Get Activity Log for IV order.
+1 FOR PSJAL=0:0
SET PSJAL=$ORDER(^PS(55,DFN,"IV",+ON,"A",PSJAL))
if 'PSJAL
QUIT
Begin DoDot:1
+2 KILL PSJ,PSJDD
+3 SET X=$GET(^PS(55,DFN,"IV",+ON,"A",PSJAL,0))
+4 SET PSJ("DATE")=$PIECE(X,U,5)
+5 SET PSJ("ACTION")=$PIECE(X,U,2)
if PSJ("ACTION")="F"
QUIT
+6 SET PSJ("USER")=$PIECE(X,U,3)
+7 SET PSJ("REASON")=$PIECE(X,U,4)
+8 SET PSJ("ACTION")=$$CODES^PSIVUTL(PSJ("ACTION"),55.04,.02)
+9 SET PSJ("UIEN")=$PIECE(X,U,6)
+10 IF PSJAL=1
IF ($GET(^PS(55,DFN,"IV",+ON,"A",PSJAL,1,1,0))["OTHER PRINT INFO")
QUIT
+11 IF $ORDER(^PS(55,DFN,"IV",+ON,"A",PSJAL,1,0))=""
DO TMP
+12 FOR PSJFC=0:0
SET PSJFC=$ORDER(^PS(55,DFN,"IV",+ON,"A",PSJAL,1,PSJFC))
if 'PSJFC
QUIT
Begin DoDot:2
+13 SET X=$GET(^PS(55,DFN,"IV",+ON,"A",PSJAL,1,PSJFC,0))
+14 KILL PSJ("FIELD"),PSJ("OLD DATA")
+15 SET PSJ("FIELD")=$PIECE(X,U)
+16 SET PSJ("OLD DATA")=$PIECE(X,U,2)
+17 DO TMP
End DoDot:2
End DoDot:1
+18 KILL PSJ,PSJAL,PSJFC
+19 QUIT
TMP ;Setup ^TMP
+1 SET PSJINX=PSJINX+1
+2 IF +PSJ("USER")
DO NAME^PSJBCMA1(+PSJ("USER"),.X,"")
SET PSJ("USER")=X
+3 SET ^TMP(PSJTMP,$JOB,0)=DFN_U_+ON_U_ON_U_PSJINX
+4 SET ^TMP(PSJTMP,$JOB,PSJINX,1)=PSJ("DATE")_U_PSJ("USER")_U_$GET(PSJ("FIELD"))_U_PSJ("ACTION")_U_$GET(PSJ("UIEN"))
+5 if $GET(PSJ("OLD DATA"))]""
SET ^TMP(PSJTMP,$JOB,PSJINX,2)=PSJ("OLD DATA")
+6 if $GET(PSJ("REASON"))]""
SET ^TMP(PSJTMP,$JOB,PSJINX,3)=PSJ("REASON")
+7 QUIT
GETFLD ;
+1 NEW X
DO FIELD^DID(55.04,.02,"","POINTER","PSJDD")
QUIT
+2 QUIT
+3 ;
FILESI(DFN,PSJORD) ; File special instructions
+1 IF PSJORD["U"
SET LN=0
Begin DoDot:1
+2 IF $GET(PSGOEENO)&($GET(PSGORD)=$GET(PSJORD))
QUIT
+3 KILL ^PS(55,DFN,5,+PSJORD,15)
IF ($GET(^PS(53.45,+$GET(PSJSYSP),5,0))<0)
SET ^PS(55,DFN,5,+PSJORD,6)=""
QUIT
+4 IF '$DATA(^PS(55,DFN,5,+PSJORD,15,1,0))
IF ($ORDER(^PS(53.45,+$GET(PSJSYSP),5," "),-1)=1)
if ($TRANSLATE(^PS(53.45,PSJSYSP,5,1,0)," ")="")
QUIT
+5 SET LNCNT=0
SET LN=9999
FOR
SET LN=$ORDER(^PS(53.45,+$GET(PSJSYSP),5,LN),-1)
if 'LN
QUIT
Begin DoDot:2
+6 IF 'LNCNT
IF ($GET(^PS(53.45,+$GET(PSJSYSP),5,LN,0))="")
QUIT
+7 IF $DATA(^PS(53.45,+$GET(PSJSYSP),5,LN,0))
SET ^PS(55,+DFN,5,+PSJORD,15,LN,0)=^PS(53.45,+$GET(PSJSYSP),5,LN,0)
SET LNCNT=LNCNT+1
End DoDot:2
+8 IF $GET(LNCNT)
SET ^PS(55,+DFN,5,+PSJORD,15,0)="^55.6135^"_+LNCNT_"^"_+LNCNT
Begin DoDot:2
+9 NEW TXT,SIMSG
SET SIMSG="Instructions too long. See Order View or BCMA for full text."
+10 SET PSJTMPTX=""
SET PSJOVRMX=0
SET TMPLIN=0
FOR
SET TMPLIN=$ORDER(^PS(55,+DFN,5,+PSJORD,15,TMPLIN))
if 'TMPLIN!(PSJOVRMX)
QUIT
Begin DoDot:3
+11 if ($LENGTH(PSJTMPTX)+$LENGTH($GET(^PS(55,+DFN,5,+PSJORD,15,TMPLIN,0))))>180
SET PSJOVRMX=1
if $GET(PSJOVRMX)
QUIT
SET PSJTMPTX=$GET(PSJTMPTX)_$SELECT($GET(PSJTMPTX)]"":" ",1:"")_$GET(^PS(55,+DFN,5,+PSJORD,15,TMPLIN,0))
End DoDot:3
+12 SET TXT=$SELECT($GET(PSJOVRMX):SIMSG,1:PSJTMPTX)
+13 IF $GET(DFN)
IF $DATA(^PS(55,DFN,5,+PSJORD,0))
SET ^PS(55,DFN,5,+PSJORD,6)=TXT_"^"_$SELECT($GET(PSGSIF):1,1:"")
End DoDot:2
+14 NEW LSTLNUM,LSTLNTXT
SET LSTLNUM=$ORDER(^PS(55,+DFN,5,+PSJORD,15,""),-1)
IF LSTLNUM>1
SET LSTLNTXT=$GET(^PS(55,+DFN,5,+PSJORD,15,LSTLNUM,0))
IF $TRANSLATE(LSTLNTXT," ")=""
Begin DoDot:2
+15 KILL ^PS(55,+DFN,5,+PSJORD,15,LSTLNUM,0)
End DoDot:2
End DoDot:1
+16 IF PSJORD["P"
SET LN=0
Begin DoDot:1
+17 NEW PSGSIF
SET PSGSIF=+$PIECE($GET(^PS(53.1,+PSJORD,6)),"^",2)
+18 IF $GET(PSGOEENO)'=1
KILL ^PS(53.1,+PSJORD,15)
+19 IF ($GET(^PS(53.45,+$GET(PSJSYSP),5,0))<0)
SET ^PS(53.1,+PSJORD,6)=""
SET ^PS(53.1,+PSJORD,15,0)="^53.1135^0^0"
QUIT
+20 IF '$DATA(^PS(53.1,+PSJORD,15,1,0))
IF ($ORDER(^PS(53.45,+$GET(PSJSYSP),5," "),-1)=1)
if ($TRANSLATE(^PS(53.45,PSJSYSP,5,1,0)," ")="")
QUIT
+21 SET LNCNT=0
SET LN=9999
FOR
SET LN=$ORDER(^PS(53.45,+$GET(PSJSYSP),5,LN),-1)
if 'LN
QUIT
Begin DoDot:2
+22 IF 'LNCNT
IF ($GET(^PS(53.45,+$GET(PSJSYSP),5,LN,0))="")
QUIT
+23 IF $DATA(^PS(53.45,+$GET(PSJSYSP),5,LN,0))
SET ^PS(53.1,+PSJORD,15,LN,0)=^PS(53.45,+$GET(PSJSYSP),5,LN,0)
SET LNCNT=LNCNT+1
End DoDot:2
+24 IF $GET(LNCNT)
SET ^PS(53.1,+PSJORD,15,0)="^53.1135^"_+LNCNT_"^"_+LNCNT
Begin DoDot:2
+25 NEW TXT,SIMSG
SET SIMSG="Instructions too long. See Order View or BCMA for full text."
+26 SET PSJTMPTX=""
SET PSJOVRMX=0
SET TMPLIN=0
FOR
SET TMPLIN=$ORDER(^PS(53.1,+PSJORD,15,TMPLIN))
if 'TMPLIN!(PSJOVRMX)
QUIT
Begin DoDot:3
+27 if ($LENGTH(PSJTMPTX)+$LENGTH($GET(^PS(53.1,+PSJORD,15,TMPLIN,0))))>180
SET PSJOVRMX=1
if $GET(PSJOVRMX)
QUIT
SET PSJTMPTX=$GET(PSJTMPTX)_$SELECT($GET(PSJTMPTX)]"":" ",1:"")_$GET(^PS(53.1,+PSJORD,15,TMPLIN,0))
End DoDot:3
+28 SET TXT=$SELECT($GET(PSJOVRMX):SIMSG,1:PSJTMPTX)
+29 IF $DATA(^PS(53.1,+$GET(PSJORD),0))
SET ^PS(53.1,+PSJORD,6)=TXT_"^"_$SELECT($GET(PSGSIF):1,1:"")
End DoDot:2
+30 NEW LSTLNUM,LSTLNTXT
SET LSTLNUM=$ORDER(^PS(53.1,+PSJORD,15,""),-1)
IF LSTLNUM>1
SET LSTLNTXT=$GET(^PS(53.1,+PSJORD,15,LSTLNUM,0))
IF $TRANSLATE(LSTLNTXT," ")=""
Begin DoDot:2
+31 KILL ^PS(53.1,+PSJORD,15,LSTLNUM,0)
End DoDot:2
End DoDot:1
+32 QUIT
FILEOPI(DFN,ORDER) ; File other print info
+1 IF PSJORD["V"
SET LN=0
Begin DoDot:1
+2 DO LOGOPI^PSIVORFB(DFN,ORDER)
+3 KILL ^PS(55,+DFN,"IV",+PSJORD,10)
SET ^PS(55,+DFN,"IV",+PSJORD,3)=""
IF '$DATA(^PS(53.45,+$GET(PSJSYSP),6,2,0))&(($GET(^PS(53.45,+$GET(PSJSYSP),6,1,0))=-1)!($GET(^PS(53.45,+$GET(PSJSYSP),6,0))=-1))
Begin DoDot:2
+4 SET ^PS(55,+DFN,"IV",+PSJORD,10,0)="^55.1154^1^1"
SET ^PS(55,+DFN,"IV",PSJORD,10,1,0)=""
End DoDot:2
QUIT
+5 IF '$DATA(^PS(55,DFN,"IV",+PSJORD,10,1,0))
IF ($ORDER(^PS(53.45,+$GET(PSJSYSP),6," "),-1)=1)
IF ($TRANSLATE(^PS(53.45,PSJSYSP,6,1,0)," ")="")
Begin DoDot:2
+6 SET ^PS(55,+DFN,"IV",+PSJORD,10,0)="^55.1154^1^1"
SET ^PS(55,+DFN,"IV",+PSJORD,10,1,0)=""
End DoDot:2
QUIT
+7 SET LNCNT=0
SET LN=9999
FOR
SET LN=$ORDER(^PS(53.45,+$GET(PSJSYSP),6,LN),-1)
if 'LN
QUIT
Begin DoDot:2
+8 IF 'LNCNT
IF ($GET(^PS(53.45,+$GET(PSJSYSP),6,LN,0))="")
QUIT
+9 IF $DATA(^PS(53.45,+$GET(PSJSYSP),6,LN,0))
SET ^PS(55,+DFN,"IV",+PSJORD,10,LN,0)=^PS(53.45,+$GET(PSJSYSP),6,LN,0)
SET LNCNT=LNCNT+1
End DoDot:2
+10 IF LNCNT
SET ^PS(55,+DFN,"IV",+PSJORD,10,0)="^55.1154^"_+LNCNT_"^"_+LNCNT
Begin DoDot:2
+11 NEW TXT,DIE,DA,OPIMSG
SET OPIMSG="Instructions too long. See Order View or BCMA for full text."
+12 SET PSJTMPTX=""
SET PSJOVRMX=0
SET TMPLIN=0
FOR
SET TMPLIN=$ORDER(^PS(55,+DFN,"IV",+PSJORD,10,TMPLIN))
if 'TMPLIN!(PSJOVRMX)
QUIT
Begin DoDot:3
+13 if ($LENGTH(PSJTMPTX)+$LENGTH($GET(^PS(55,DFN,"IV",+PSJORD,10,TMPLIN,0))))>60
SET PSJOVRMX=1
if $GET(PSJOVRMX)
QUIT
SET PSJTMPTX=$GET(PSJTMPTX)_$SELECT($GET(PSJTMPTX)]"":" ",1:"")_$GET(^PS(55,DFN,"IV",+PSJORD,10,TMPLIN,0))
End DoDot:3
+14 SET TXT=$SELECT($GET(PSJOVRMX):OPIMSG,1:$GET(PSJTMPTX))
+15 IF $TRANSLATE(TXT,"^ ")=""
SET ^PS(55,DFN,"IV",+PSJORD,3)=""
QUIT
+16 SET ^PS(55,DFN,"IV",+PSJORD,3)=TXT_"^"_$PIECE($GET(P("OPI")),"^",2)
End DoDot:2
End DoDot:1
+17 IF PSJORD["P"
Begin DoDot:1
+18 IF $DATA(^PS(53.1,+PSJORD,16))
IF $$DIFFOPI^PSJBCMA5(DFN,PSJORD)
Begin DoDot:2
+19 NEW SIARRAY,PSJALORD
MERGE SIARRAY=^PS(53.1,+PSJORD,16),PSJALORD=PSJORD
IF '$DATA(SIARRAY)
SET SIARRAY(0)="^^1^1"
SET SIARRAY(1,0)=" "
+20 DO NEWNVAL^PSGAL5(PSJORD,6000,"OTHER PRINT INFO",,.SIARRAY)
End DoDot:2
+21 KILL ^PS(53.1,+PSJORD,16)
IF ('$DATA(^PS(53.45,+$GET(PSJSYSP),6,2,0))&($TRANSLATE($GET(^PS(53.45,+$GET(PSJSYSP),6,1,0)),"^ ")=""))!+($GET(^PS(53.45,+$GET(PSJSYSP),6,0))=-1)
Begin DoDot:2
+22 SET ^PS(53.1,+PSJORD,9)=""
SET ^PS(53.1,+PSJORD,16,0)="^53.1136^1^1"
SET ^PS(53.1,+PSJORD,16,1,0)=""
End DoDot:2
QUIT
+23 IF '$DATA(^PS(53.1,+PSJORD,16,1,0))
IF ($ORDER(^PS(53.45,+$GET(PSJSYSP),6," "),-1)=1)
IF ($TRANSLATE(^PS(53.45,PSJSYSP,6,1,0)," ")="")
Begin DoDot:2
+24 SET ^PS(53.1,+PSJORD,9)=""
SET ^PS(53.1,+PSJORD,16,0)="^53.1136^1^1"
SET ^PS(53.1,+PSJORD,16,1,0)=""
End DoDot:2
QUIT
+25 SET LNCNT=0
SET LN=9999
FOR
SET LN=$ORDER(^PS(53.45,+PSJSYSP,6,LN),-1)
if 'LN
QUIT
Begin DoDot:2
+26 IF 'LNCNT
IF ($GET(^PS(53.45,+PSJSYSP,6,LN,0))="")
QUIT
+27 IF $DATA(^PS(53.45,+PSJSYSP,6,LN,0))
SET ^PS(53.1,+PSJORD,16,LN,0)=^PS(53.45,+PSJSYSP,6,LN,0)
SET LNCNT=LNCNT+1
End DoDot:2
+28 IF $GET(LNCNT)
SET ^PS(53.1,+PSJORD,16,0)="^53.1136^"_+LNCNT_"^"_+LNCNT
Begin DoDot:2
+29 NEW TXT,DIE,DA,OPIMSG
SET OPIMSG="Instructions too long. See Order View or BCMA for full text."
+30 SET PSJTMPTX=""
SET PSJOVRMX=0
SET TMPLIN=0
FOR
SET TMPLIN=$ORDER(^PS(53.1,+PSJORD,16,TMPLIN))
if 'TMPLIN!(PSJOVRMX)
QUIT
Begin DoDot:3
+31 if ($LENGTH(PSJTMPTX)+$LENGTH($GET(^PS(53.1,+PSJORD,16,TMPLIN,0))))>60
SET PSJOVRMX=1
if $GET(PSJOVRMX)
QUIT
SET PSJTMPTX=$GET(PSJTMPTX)_$SELECT($GET(PSJTMPTX)]"":" ",1:"")_$GET(^PS(53.1,+PSJORD,16,TMPLIN,0))
End DoDot:3
+32 SET TXT=$SELECT($GET(PSJOVRMX):OPIMSG,1:$GET(PSJTMPTX))
+33 SET $PIECE(^PS(53.1,+PSJORD,9),"^",2)=TXT
SET $PIECE(^PS(53.1,+PSJORD,9),"^",3)=$PIECE($GET(P("OPI")),"^",2)
End DoDot:2
End DoDot:1
+34 QUIT
