PSIVORFB ;BIR/MLM - FILE/RETRIEVE ORDERS IN ^PS(55 ;Nov 2, 2021@12:53:00
;;5.0;INPATIENT MEDICATIONS;**3,18,28,68,58,85,110,111,120,134,213,161,181,273,267,285,257,299,323,335,416,399**;16 DEC 97;Build 64
;
; Reference to ^PS(50.7 is supported by DBIA #2180.
; Reference to ^PS(51.2 is supported by DBIA #2178.
; Reference to ^PS(52.6 is supported by DBIA #1231.
; Reference to ^PS(52.7 is supported by DBIA #2173.
; Reference to ^PS(55 is supported by DBIA #2191.
; Reference to ^PS(51.1 is supported by DBIA #2177.
; Reference to ^PSUHL is supported by DBIA #4803.
;
NEW55 ; Get new order number in 55.
N DA,DD,DO,DIC,DLAYGO,X,Y,PSIVLIM,MINS,PSJDSTP1,PSJDSTP2,A,PSJCLIN,PSJDNM,PSJPROV,PSJWARD,PSJPAO,PSJALRT
I ($G(PSIVAC)="PN"),$G(PSJSYSP) D KILL^PSJBCMA5(+$G(PSJSYSP))
I $D(^PS(55,+DFN)),'$D(^PS(55,+DFN,0)) D ENSET0^PSGNE3(+DFN)
;*273 - Set PSIVSITE if not set.
I $G(PSJORD)["V"!($G(PSJORD)["P"),$G(P(2))]"" D
. I '$G(PSIVSITE) S PSIVSN=$P(P("IVRM"),"^") D ENCHK^PSIVSET
. D LIMSTOP(.PSJDSTP1,.PSJDSTP2)
I ($G(PSJORD)["P"!($G(PSJORD)["V"))&$G(PSIVLIM) I $$CMPLIM(PSJORD,PSJDSTP1,PSJDSTP2) D
. D
.. S PSJPROV=DUZ I PSJORD["P" S PSJPROV=$P($G(^PS(53.1,+PSJORD,0)),"^",2)
.. I PSJORD["V" S PSJPROV=$P($G(^PS(55,DFN,"IV",+PSJORD,0)),"^",6)
.. D NOW^%DTC S XQA(PSJPROV)="",XQAID="PSJ,"_DFN_";"_PSJPROV_";"_%,XQADATA=""
.. D
... I PSJORD["P" S A=$G(^PS(53.1,+PSJORD,"DSS"))
... I PSJORD["V" S A=$G(^PS(55,PSGP,"IV",+PSJORD,"DSS"))
... S PSJCLIN=$P(A,"^") I PSJCLIN]"" S PSJCLIN=$P(^SC(PSJCLIN,0),"^")
.. S A=$G(^DPT(DFN,0)),PSJWARD=$G(^(.1))
.. S XQAMSG=$P(A,"^")_" ("_$E($P(A,"^"))_$E($P(A,"^",9),6,9)_"): ["_$S(PSJWARD]"":$E(PSJWARD,1,10),$G(PSJCLIN)]"":$E(PSJCLIN,1,10),1:"UNKNOWN")_"] "
.. S A=$O(DRG("AD",0)) I A]"" S A=DRG("AD",A)
.. I A="" S A=$O(DRG("SOL",0)) I A]"" S A=DRG("SOL",A)
.. S PSJDNM=$P(^PS(50.7,+$P(A,"^",6),0),"^")
.. S XQAMSG=XQAMSG_PSJDNM_" your DURATION not used for stop date/time"
.. D SETUP^XQALERT
.. S PSJALRT=$$FMTDUR^PSJLIVMD($S(PSJORD["P":$P($G(^PS(53.1,+PSJORD,2.5)),"^",4),PSJORD["IV":$P($G(^PS(55,DFN,"IV",+PSJORD,2.5)),"^",4),1:"UNK"))
S DIC="^PS(55,",DIC(0)="LN",DLAYGO=55,(DINUM,X)=+DFN D ^DIC Q:Y<0
LOCK0 F L +^PS(55,DFN,"IV",0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
S ND=$S($D(^PS(55,DFN,"IV",0)):^(0),1:"^55.01") F DA=$P(ND,"^",3)+1:1 W "." I '$D(^PS(55,DFN,"IV",DA)) S $P(ND,"^",3)=DA,$P(ND,"^",4)=$P(ND,"^",4)+1,^PS(55,DFN,"IV",0)=ND Q
L +^PS(55,DFN,"IV",+DA):$S($G(DILOCKTM)>0:DILOCKTM,1:3) E G LOCK0
S ^PS(55,DFN,"IV",+DA,0)=+DA,^PS(55,DFN,"IV","B",+DA,+DA)=""
L -^PS(55,DFN,"IV",0) S ON55=+DA_"V"
I $G(PSJALRT)]"" S PSIVAL="IV LIMIT OVERRIDDEN ("_$G(PSJALRT)_"): ALERT SENT",PSIVALT="",PSIVREA="E" D
.D LOG^PSIVORAL S P("LIMIT")="",P("OVRIDE")=1 K IVLIM,IVLIMIT
.S $P(^PS(55,DFN,"IV",+ON55,2.5),"^",4)="" S:$G(PSJORD)["P" $P(^PS(53.1,+PSJORD,2.5),"^",4)=""
.K PSIVAL,PSIVREA,PSIVALT
I $G(PSIVCOPY)=1,$G(OLDON) I (OLDON["V")&(OLDON'=(+DA_"V")) D GETOPI^PSJBCMA5(DFN,OLDON)
I $P($G(^PS(53.45,+$G(DUZ),6,0)),"^",3) D
.N PSJTROPI,PSJNVO S PSJNVO=$G(P("NEWON")) I (PSJNVO["P") D FILEOPI^PSJBCMA5(DFN,PSJNVO) S PSJTROPI=$$GETOPI^PSJBCMA5(DFN,PSJNVO) Q
.I ($G(P("PON"))["P"),($G(ON55)["V") S PSJNVO=P("PON") D FILEOPI^PSJBCMA5(DFN,PSJNVO) S PSJTROPI=$$GETOPI^PSJBCMA5(DFN,PSJNVO) Q
.D FILEOPI^PSJBCMA5(DFN,ON55) S PSJTROPI=$$GETOPI^PSJBCMA5(DFN,ON55)
Q
SET55 ; Move data from local variables to 55.
I '$D(ON55) W !,"*** Can't create this order at this time ***" Q
N DA,DIK,ND,PSIVACT,PSIVDUR,PSJTROPI,PSJTROPL
I P(9)["PRN" S $P(ZZND,"^",3)="",PSGS0XT="",P(15)="" ;*323 - If the schedule is changed to PRN, make sure the frequency of the original schedule is removed.
I (($P($G(ZZND),"^",3))=""&($G(PSGS0XT)="")) S P(15)="" ;*285 - Prevent frequency hangover when changing from non-null to null
S:'$D(P(21)) (P(21),P("21FLG"))="" S ND(0)=+ON55,P(22)=$S(VAIN(4):+VAIN(4),1:.5) F X=2:1:23 I $D(P(X)) S $P(ND(0),U,X)=P(X)
S ND(.3)=$G(P("INS")),ND(2.5)="" N X S X=$S($G(PSGORD):PSGORD,1:$G(ON)) I X D
.N PKG S PKG=$E(X,$L(X)) S PKG=$S(PKG="V":"""IV""",PKG="U":5,PKG="P":"P",1:"") Q:PKG=""
.S PSIVDUR=$$GETDUR^PSJLIVMD(DFN,+X,$E(X,$L(X)),1) Q:PSIVDUR=""
.I $G(IVLIMIT) S ND(2.5)="^^^"_PSIVDUR K IVLIMIT Q
I P("DTYP")]"" S P("DO")=""
S $P(ND(0),U,17)="A",ND(1)=P("REM"),ND(3)=P("OPI"),ND(.2)=$P($G(P("PD")),U)_U_$G(P("DO"))_U_+P("MR")_U_$G(P("PRY"))_U_$G(P("NAT"))_U_U_U_$G(P("PRNTON"))
F X=0,1,2.5,3,.2,.3 S ^PS(55,DFN,"IV",+ON55,X)=ND(X)
; PSJ*5*213 - if Piggyback, intermittent syringe, or
; intermittent chemotherapy, and frequency is null, attempt to
; set frequency again based on P(15),PSGS0XT, and piece 3 of ZZND if they exist.
; If this still is null, attempt to re-set based upon the schedule name.
I $G(P("IVCAT"))="I"!($P($G(ND(0)),U,4)?1(1"P",1"S",1"C"))&($P($G(ND(0)),U,15)="") D
. I $P($G(ND(0)),U,4)="S",$P($G(ND(0)),U,5)'=1 Q ;Not intermittent syringe
. I $P($G(ND(0)),U,4)="C",$P($G(ND(0)),U,23)?1(1"A",1"H") Q ;Not chemo piggyback or syringe
. I $P($G(ND(0)),U,4)="C",$P($G(ND(0)),U,23)="S",$P($G(ND(0)),U,5)'=1 Q ;Not intermitent chemo syringe
. S $P(^PS(55,DFN,"IV",+ON55,0),U,15)=$S($G(P(15))'="":P(15),$G(PSGS0XT)'="":PSGS0XT,$P($G(ZZND),"^",3)'="":$P(ZZND,"^",3),1:$$GETFRQ($P($G(ND(0)),U,9))) K PSJFRQ,PSJSKED
S $P(^PS(55,DFN,"IV",+ON55,2),U,1,4)=P("LOG")_U_+P("IVRM")_U_U_P("SYRS"),$P(^(2),U,8,10)=P("RES")_U_$G(P("FRES"))_U_$S($G(VAIN(4)):+VAIN(4),1:"")
S X=^PS(55,DFN,0) I $P(X,"^",7)="" S $P(X,"^",7)=$P($P(P("LOG"),"^"),"."),$P(X,"^",8)="A",^(0)=X D LOGDFN^PSUHL(DFN)
S $P(^PS(55,DFN,"IV",+ON55,2),U,11)=+P("CLRK")
S:+$G(P("CLIN")) $P(^PS(55,DFN,"IV",+ON55,"DSS"),"^")=P("CLIN")
S:+$G(P("APPT")) $P(^PS(55,DFN,"IV",+ON55,"DSS"),"^",2)=P("APPT")
S:+$G(P("NINIT")) ^PS(55,DFN,"IV",+ON55,4)=P("NINIT")_U_P("NINITDT")
S:$G(P("IND"))]"" ^PS(55,DFN,"IV",+ON55,18)=P("IND") ;*399-IND
I '$D(^PS(53.45,PSJSYSP,6)),($G(P("NEWON"))["P") S PSJTROPI=P("NEWON") S PSJTROPL=$$GETOPI^PSJBCMA5(DFN,PSJTROPI)
I $G(^PS(53.45,PSJSYSP,6))!$P($G(^PS(53.45,PSJSYSP,6,0)),"^",3) D
. I $G(PSJCOM),$G(PSJCOMSI),$G(PSJORD)["V" M ^TMP("PSJOPI",$J,6)=^PS(53.45,PSJSYSP,6)
. D FILEOPI^PSJBCMA5(DFN,ON55) ;P416 K ^TMP("PSJOPI",$J,6) - comment out since its use the merge below
I '$G(PSIVCHG)!($G(PSJREN)&($G(PSIVCHG)=2)) I $G(P("PON")),P("PON")'=ON55 D
. N X S X=$S(P("PON")["P":"^PS(53.1,+P(""PON""),12,0)",P("PON")["V"&$G(PSJREN):"^PS(55,DFN,""IV"",+P(""PON""),5,0)",1:"") Q:X=""
. I $O(@X) S %X=X,%Y="^PS(55,"_DFN_",""IV"","_+ON55_",5," D %XY^%RCR
F DRGT="AD","SOL" D PUTD55
K DA,DIK S DA(1)=DFN,DA=+ON55,DIK="^PS(55,"_DA(1)_",""IV"",",PSIVACT=1 D IX^DIK
I $G(PSJCOM),$G(PSJCOMSI),$G(PSJORD)["V" K PSJCOMSI N PSJCHILD,PSJOEORD S PSJOEORD=0 F S PSJOEORD=$O(^PS(55,"ACX",PSJCOM,PSJOEORD)) Q:'PSJOEORD D
. N PSJCHILD S PSJCHILD=0 F S PSJCHILD=$O(^PS(55,"ACX",PSJCOM,PSJOEORD,PSJCHILD)) Q:'PSJCHILD S PSJCHILD(+PSJCHILD)=PSJCOM
. S PSJCHILD=0 F S PSJCHILD=$O(PSJCHILD(PSJCHILD)) Q:'PSJCHILD D
.. Q:PSJCHILD=PSJORD K DR,DA,DIE,ORD S DR="31////"_$P($G(P("OPI")),"^",1,2),DA(1)=DFN
.. N ON,ON55 S (ON,ON55)=+PSJCHILD_"V" S:+$G(PSJPINIT)'>0 PSJPINIT=DUZ S PSIVALT=1,PSIVAL="COMPLEX ORDER" D ENTACT^PSIVAL D
... I $P($G(^PS(55,DFN,"IV",+ON55,3)),"^")'=$P(P("OPI"),"^") S P("FC")="OTHER PRINT INFO^"_$P($G(^(3)),"^")_U_$P(P("OPI"),"^") D GTFC^PSIVORAL
... K ^PS(55,DFN,"IV",+ON55,10)
... M ^PS(55,DFN,"IV",+ON55,10)=^TMP("PSJOPI",$J,6)
... I $D(^PS(55,DFN,"IV",+ON55,0)) S ^PS(55,DFN,"IV",+ON55,3)=P("OPI") D EN1^PSJHL2(DFN,"XX",ON55)
K ^TMP("PSJOPI",$J)
Q
;
PUTD55 ; Move drug data from local array into 55
K ^PS(55,DFN,"IV",+ON55,DRGT) S ^PS(55,DFN,"IV",+ON55,DRGT,0)=$S(DRGT="AD":"^55.02PA",1:"^55.11IPA")
F X=0:0 S X=$O(DRG(DRGT,X)) Q:'X D
.S Y=^PS(55,DFN,"IV",+ON55,DRGT,0),$P(Y,U,3)=$P(Y,U,3)+1,DRG=$P(Y,U,3),$P(Y,U,4)=$P(Y,U,4)+1
.S ^PS(55,DFN,"IV",+ON55,DRGT,0)=Y,Y=$P(DRG(DRGT,X),U)_U_$P(DRG(DRGT,X),U,3) S:DRGT="AD" $P(Y,U,3)=$P(DRG(DRGT,X),U,4) S ^PS(55,DFN,"IV",+ON55,DRGT,+DRG,0)=Y
Q
GT55 ; Retrieve data from 55 into local array
K DRG,DRGN,P S:'$D(ON55) ON55=ON S P("REN")="",Y=$G(^PS(55,DFN,"IV",+ON55,0)) F X=1:1:25 S P(X)=$P(Y,U,X)
S P("21FLG")=P(21)
S P("PON")=ON55,PSJORIFN=P(21),P(6)=P(6)_U_$P($G(^VA(200,+P(6),0)),U),(DRG,DRGN)="",P("REM")=$G(^PS(55,DFN,"IV",+ON55,1))
S Y=$G(^PS(55,DFN,"IV",+ON55,2)),P("LOG")=$P(Y,U),P("IVRM")=$P(Y,U,2)_U_$P($G(^PS(59.5,+$P(Y,U,2),0)),U)
S P("CLRK")=$P(Y,U,11)_U_$P($G(^VA(200,+$P(Y,U,11),0)),U),P("RES")=$P(Y,U,8),P("FRES")=$P(Y,U,9),P("SYRS")=$P(Y,U,4),P("OPI")=$G(^PS(55,DFN,"IV",+ON55,3))
S P("INS")=$G(^PS(55,DFN,"IV",+ON55,.3))
S P("IND")=$G(^PS(55,DFN,"IV",+ON55,18)) ;*399-IND
S P("CLIN")=$P($G(^PS(55,DFN,"IV",+ON55,"DSS")),"^"),P("APPT")=$P($G(^PS(55,DFN,"IV",+ON55,"DSS")),"^",2)
S P("DTYP")=$S(P(4)="":0,P(4)="P"!(P(23)="P")!(P(5)):1,P(4)="H":2,1:3)
D:'$D(PSJLABEL) GTPC(ON55) S ND=$G(^PS(55,DFN,"IV",+ON55,.2)),P("PD")=$S($P(ND,U):$P(ND,U)_U_$$OIDF^PSJLMUT1(+ND)_U_$P($G(^PS(50.7,+ND,0)),U),1:""),P("DO")=$P(ND,U,2),P("PRY")=$P(ND,U,4),P("NAT")=$P(ND,U,5),(PSJCOM,P("PRNTON"))=$P(ND,U,8)
I P("PRY")="D",'+P("IVRM") S P("IVRM")=+$G(PSIVSN)_U_$P($G(^PS(59.5,+$G(PSIVSN),0)),U)
S P("MR")=$P(ND,U,3),ND=$G(^PS(51.2,+P("MR"),0)),P("MR")=P("MR")_U_$S($P(ND,U,3)]"":$P(ND,U,3),1:$P(ND,U)) D GTCUM
D GTDRG,GTOT^PSIVUTL(P(4))
N ND2P5 S ND2P5=$G(^PS(55,DFN,"IV",+ON55,2.5)) D
.S P("DUR")=$P(ND2P5,"^",2)
.S P("LIMIT")=$P(ND2P5,"^",4)
.S P("IVCAT")=$P(ND2P5,"^",5)
K ; Kill and exit.
K FIL,ND
Q
GTDRG ; Get drug info and place in DRG(.
F DRGT="AD","SOL" S FIL=$S(DRGT="AD":52.6,1:52.7) F Y=0:0 S Y=$O(^PS(55,DFN,"IV",+ON55,DRGT,Y)) Q:'Y D
.; naked ref below refers to line above
.S DRG=$G(^(Y,0)),ND=$G(^PS(FIL,+DRG,0)),(DRGI,DRG(DRGT,0))=$G(DRG(DRGT,0))+1
.S DRG(DRGT,+DRGI)=+DRG_U_$P(ND,U)_U_$P(DRG,U,2)_U_$P(DRG,U,3)_U_$P(ND,U,13)_U_$P(ND,U,11)
Q
;
GTCUM ; Retrieve dispensing info.
S ND=$G(^PS(55,DFN,"IV",+ON55,9)),P("LF")=$P(ND,U),P("LFA")=$P(ND,U,2),P("CUM")=$P(ND,U,3)
Q
;
GTPC(ON) ; Retrieve Provider Comments and create "scratch" fields to edit
Q
;
SETNEW ; Create new order and set
D NEW55,SET55
Q
;
CMPLIM(PSJORD,PSJDSTP1,PSJDSTP2) ; Compare stop date of order against IV Limit
I $P($G(^PS(53.1,+PSJORD,0)),"^",25)]"" D CHKD Q:PSJPAO 0
I $G(PSJDSTP1),$E(+PSJDSTP1,1,11)'=$E(+P(3),1,11),+PSJDSTP2'=+P(3) Q 1
Q 0
;
LIMSTOP(PSJDSTP1,PSJDSTP2) ; Calculate default stop date using IV Limit
; Output: PSJDSTP1 - Default stop using duration only
; PSJDSTP2 - Default stop using duration and IV parameters for time
S PSIVLIM=$$GETLIM^PSIVCAL(DFN,PSJORD)
I 'PSIVLIM,PSIVLIM]"" S PSIVLIM=$$GETMIN^PSIVCAL(PSIVLIM,DFN,PSJORD)
I PSIVLIM]"" D
. S MINS=$$GETMIN^PSIVCAL(PSIVLIM,DFN,PSJORD),PSJDSTP1=$$FMADD^XLFDT(P(2),,,MINS)
. S X=$P(PSJDSTP1,"."),PSJDSTP2=X_$S($P($G(PSIVSITE),"^",14)="":.2359,1:"."_$P(PSIVSITE,"^",14))
Q
;
GETFRQ(PSJSKED) ;Get frequency using name of schedule
I PSJSKED="" K PSJSKED Q ""
S (PSJCNTX,PSJFRQ)=""
I $D(^PS(51.1,"APPSJ",PSJSKED)) F S PSJCNTX=$O(^PS(51.1,"APPSJ",PSJSKED,PSJCNTX)) Q:PSJCNTX="" D Q:$G(PSJFRQ)'=""
. I $P($G(^PS(51.1,PSJCNTX,0)),U,3)'="" S PSJFRQ=$P(^PS(51.1,PSJCNTX,0),U,3)
K PSJCNTX
Q PSJFRQ
;
CHKD ;Check for a previous active order and compare the duration
N PSJPO,A,PSJDUR
S PSJDUR=$$GETLIM^PSIVCAL(DFN,PSJORD)
S PSJPAO=0,PSJPO=PSJORD
CHKDR S PSJPO=$P($G(^PS(53.1,+PSJPO,0)),"^",25) Q:PSJPO=""
I PSJPO["P" G CHKDR
I PSJPO["V" S PSIVLIM=$$GETLIM^PSIVCAL(DFN,PSJPO) I PSJDUR'=PSIVLIM S PSJPAO=1 Q
G CHKDR
;
LOGOPI(DFN,ON55) ; Log OPI activity into activity log
N PSJPICHK
I ON55["V" D
.I ($G(P("PON"))["V"),($G(ON55)["V"),(ON55'=P("PON")) D
..K PSJARRY1,PSJARRY2 M PSJARRY1=^PS(53.45,+$G(PSJSYSP),6),PSJARRY2=^PS(55,DFN,"IV",+P("PON"),10) S PSJPICHK='$$DIFFAR^PSJBCMA5(.PSJARRY1,.PSJARRY2)
.Q:$G(PSJPICHK)
.N PSIVALCK,PSIVRA,PSIVLN,PSIVLSTA S PSIVLN=$O(^PS(55,DFN,"IV",+ON55,"A",""),-1)+1
.K PSJARRY1,PSJARRY2 S PSJARRY1="",PSJARRY2="" M PSJARRY1=^PS(53.45,+$G(PSJSYSP),6),PSJARRY2=^PS(55,DFN,"IV",+ON55,10) Q:'$$DIFFAR^PSJBCMA5(.PSJARRY1,.PSJARRY2)
.S P("FC")="OTHER PRINT INFO^"_$P($G(^PS(55,DFN,"IV",+ON55,3)),"^")_U_$P($G(P("OPI")),"^"),PSIVALCK="OPI",PSIVREA="E" D LOG^PSIVORAL
K PSJARRY1,PSJARRY2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVORFB 12334 printed Apr 09, 2024@21:10:06 Page 2
PSIVORFB ;BIR/MLM - FILE/RETRIEVE ORDERS IN ^PS(55 ;Nov 2, 2021@12:53:00
+1 ;;5.0;INPATIENT MEDICATIONS;**3,18,28,68,58,85,110,111,120,134,213,161,181,273,267,285,257,299,323,335,416,399**;16 DEC 97;Build 64
+2 ;
+3 ; Reference to ^PS(50.7 is supported by DBIA #2180.
+4 ; Reference to ^PS(51.2 is supported by DBIA #2178.
+5 ; Reference to ^PS(52.6 is supported by DBIA #1231.
+6 ; Reference to ^PS(52.7 is supported by DBIA #2173.
+7 ; Reference to ^PS(55 is supported by DBIA #2191.
+8 ; Reference to ^PS(51.1 is supported by DBIA #2177.
+9 ; Reference to ^PSUHL is supported by DBIA #4803.
+10 ;
NEW55 ; Get new order number in 55.
+1 NEW DA,DD,DO,DIC,DLAYGO,X,Y,PSIVLIM,MINS,PSJDSTP1,PSJDSTP2,A,PSJCLIN,PSJDNM,PSJPROV,PSJWARD,PSJPAO,PSJALRT
+2 IF ($GET(PSIVAC)="PN")
IF $GET(PSJSYSP)
DO KILL^PSJBCMA5(+$GET(PSJSYSP))
+3 IF $DATA(^PS(55,+DFN))
IF '$DATA(^PS(55,+DFN,0))
DO ENSET0^PSGNE3(+DFN)
+4 ;*273 - Set PSIVSITE if not set.
+5 IF $GET(PSJORD)["V"!($GET(PSJORD)["P")
IF $GET(P(2))]""
Begin DoDot:1
+6 IF '$GET(PSIVSITE)
SET PSIVSN=$PIECE(P("IVRM"),"^")
DO ENCHK^PSIVSET
+7 DO LIMSTOP(.PSJDSTP1,.PSJDSTP2)
End DoDot:1
+8 IF ($GET(PSJORD)["P"!($GET(PSJORD)["V"))&$GET(PSIVLIM)
IF $$CMPLIM(PSJORD,PSJDSTP1,PSJDSTP2)
Begin DoDot:1
+9 Begin DoDot:2
+10 SET PSJPROV=DUZ
IF PSJORD["P"
SET PSJPROV=$PIECE($GET(^PS(53.1,+PSJORD,0)),"^",2)
+11 IF PSJORD["V"
SET PSJPROV=$PIECE($GET(^PS(55,DFN,"IV",+PSJORD,0)),"^",6)
+12 DO NOW^%DTC
SET XQA(PSJPROV)=""
SET XQAID="PSJ,"_DFN_";"_PSJPROV_";"_%
SET XQADATA=""
+13 Begin DoDot:3
+14 IF PSJORD["P"
SET A=$GET(^PS(53.1,+PSJORD,"DSS"))
+15 IF PSJORD["V"
SET A=$GET(^PS(55,PSGP,"IV",+PSJORD,"DSS"))
+16 SET PSJCLIN=$PIECE(A,"^")
IF PSJCLIN]""
SET PSJCLIN=$PIECE(^SC(PSJCLIN,0),"^")
End DoDot:3
+17 SET A=$GET(^DPT(DFN,0))
SET PSJWARD=$GET(^(.1))
+18 SET XQAMSG=$PIECE(A,"^")_" ("_$EXTRACT($PIECE(A,"^"))_$EXTRACT($PIECE(A,"^",9),6,9)_"): ["_$SELECT(PSJWARD]"":$EXTRACT(PSJWARD,1,10),$GET(PSJCLIN)]"":$EXTRACT(PSJCLIN,1,10),1:"UNKNOWN")_"] "
+19 SET A=$ORDER(DRG("AD",0))
IF A]""
SET A=DRG("AD",A)
+20 IF A=""
SET A=$ORDER(DRG("SOL",0))
IF A]""
SET A=DRG("SOL",A)
+21 SET PSJDNM=$PIECE(^PS(50.7,+$PIECE(A,"^",6),0),"^")
+22 SET XQAMSG=XQAMSG_PSJDNM_" your DURATION not used for stop date/time"
+23 DO SETUP^XQALERT
+24 SET PSJALRT=$$FMTDUR^PSJLIVMD($SELECT(PSJORD["P":$PIECE($GET(^PS(53.1,+PSJORD,2.5)),"^",4),PSJORD["IV":$PIECE($GET(^PS(55,DFN,"IV",+PSJORD,2.5)),"^",4),1:"UNK"))
End DoDot:2
End DoDot:1
+25 SET DIC="^PS(55,"
SET DIC(0)="LN"
SET DLAYGO=55
SET (DINUM,X)=+DFN
DO ^DIC
if Y<0
QUIT
LOCK0 FOR
LOCK +^PS(55,DFN,"IV",0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF $TEST
QUIT
+1 SET ND=$SELECT($DATA(^PS(55,DFN,"IV",0)):^(0),1:"^55.01")
FOR DA=$PIECE(ND,"^",3)+1:1
WRITE "."
IF '$DATA(^PS(55,DFN,"IV",DA))
SET $PIECE(ND,"^",3)=DA
SET $PIECE(ND,"^",4)=$PIECE(ND,"^",4)+1
SET ^PS(55,DFN,"IV",0)=ND
QUIT
+2 LOCK +^PS(55,DFN,"IV",+DA):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF '$TEST
GOTO LOCK0
+3 SET ^PS(55,DFN,"IV",+DA,0)=+DA
SET ^PS(55,DFN,"IV","B",+DA,+DA)=""
+4 LOCK -^PS(55,DFN,"IV",0)
SET ON55=+DA_"V"
+5 IF $GET(PSJALRT)]""
SET PSIVAL="IV LIMIT OVERRIDDEN ("_$GET(PSJALRT)_"): ALERT SENT"
SET PSIVALT=""
SET PSIVREA="E"
Begin DoDot:1
+6 DO LOG^PSIVORAL
SET P("LIMIT")=""
SET P("OVRIDE")=1
KILL IVLIM,IVLIMIT
+7 SET $PIECE(^PS(55,DFN,"IV",+ON55,2.5),"^",4)=""
if $GET(PSJORD)["P"
SET $PIECE(^PS(53.1,+PSJORD,2.5),"^",4)=""
+8 KILL PSIVAL,PSIVREA,PSIVALT
End DoDot:1
+9 IF $GET(PSIVCOPY)=1
IF $GET(OLDON)
IF (OLDON["V")&(OLDON'=(+DA_"V"))
DO GETOPI^PSJBCMA5(DFN,OLDON)
+10 IF $PIECE($GET(^PS(53.45,+$GET(DUZ),6,0)),"^",3)
Begin DoDot:1
+11 NEW PSJTROPI,PSJNVO
SET PSJNVO=$GET(P("NEWON"))
IF (PSJNVO["P")
DO FILEOPI^PSJBCMA5(DFN,PSJNVO)
SET PSJTROPI=$$GETOPI^PSJBCMA5(DFN,PSJNVO)
QUIT
+12 IF ($GET(P("PON"))["P")
IF ($GET(ON55)["V")
SET PSJNVO=P("PON")
DO FILEOPI^PSJBCMA5(DFN,PSJNVO)
SET PSJTROPI=$$GETOPI^PSJBCMA5(DFN,PSJNVO)
QUIT
+13 DO FILEOPI^PSJBCMA5(DFN,ON55)
SET PSJTROPI=$$GETOPI^PSJBCMA5(DFN,ON55)
End DoDot:1
+14 QUIT
SET55 ; Move data from local variables to 55.
+1 IF '$DATA(ON55)
WRITE !,"*** Can't create this order at this time ***"
QUIT
+2 NEW DA,DIK,ND,PSIVACT,PSIVDUR,PSJTROPI,PSJTROPL
+3 ;*323 - If the schedule is changed to PRN, make sure the frequency of the original schedule is removed.
IF P(9)["PRN"
SET $PIECE(ZZND,"^",3)=""
SET PSGS0XT=""
SET P(15)=""
+4 ;*285 - Prevent frequency hangover when changing from non-null to null
IF (($PIECE($GET(ZZND),"^",3))=""&($GET(PSGS0XT)=""))
SET P(15)=""
+5 if '$DATA(P(21))
SET (P(21),P("21FLG"))=""
SET ND(0)=+ON55
SET P(22)=$SELECT(VAIN(4):+VAIN(4),1:.5)
FOR X=2:1:23
IF $DATA(P(X))
SET $PIECE(ND(0),U,X)=P(X)
+6 SET ND(.3)=$GET(P("INS"))
SET ND(2.5)=""
NEW X
SET X=$SELECT($GET(PSGORD):PSGORD,1:$GET(ON))
IF X
Begin DoDot:1
+7 NEW PKG
SET PKG=$EXTRACT(X,$LENGTH(X))
SET PKG=$SELECT(PKG="V":"""IV""",PKG="U":5,PKG="P":"P",1:"")
if PKG=""
QUIT
+8 SET PSIVDUR=$$GETDUR^PSJLIVMD(DFN,+X,$EXTRACT(X,$LENGTH(X)),1)
if PSIVDUR=""
QUIT
+9 IF $GET(IVLIMIT)
SET ND(2.5)="^^^"_PSIVDUR
KILL IVLIMIT
QUIT
End DoDot:1
+10 IF P("DTYP")]""
SET P("DO")=""
+11 SET $PIECE(ND(0),U,17)="A"
SET ND(1)=P("REM")
SET ND(3)=P("OPI")
SET ND(.2)=$PIECE($GET(P("PD")),U)_U_$GET(P("DO"))_U_+P("MR")_U_$GET(P("PRY"))_U_$GET(P("NAT"))_U_U_U_$GET(P("PRNTON"))
+12 FOR X=0,1,2.5,3,.2,.3
SET ^PS(55,DFN,"IV",+ON55,X)=ND(X)
+13 ; PSJ*5*213 - if Piggyback, intermittent syringe, or
+14 ; intermittent chemotherapy, and frequency is null, attempt to
+15 ; set frequency again based on P(15),PSGS0XT, and piece 3 of ZZND if they exist.
+16 ; If this still is null, attempt to re-set based upon the schedule name.
+17 IF $GET(P("IVCAT"))="I"!($PIECE($GET(ND(0)),U,4)?1(1"P",1"S",1"C"))&($PIECE($GET(ND(0)),U,15)="")
Begin DoDot:1
+18 ;Not intermittent syringe
IF $PIECE($GET(ND(0)),U,4)="S"
IF $PIECE($GET(ND(0)),U,5)'=1
QUIT
+19 ;Not chemo piggyback or syringe
IF $PIECE($GET(ND(0)),U,4)="C"
IF $PIECE($GET(ND(0)),U,23)?1(1"A",1"H")
QUIT
+20 ;Not intermitent chemo syringe
IF $PIECE($GET(ND(0)),U,4)="C"
IF $PIECE($GET(ND(0)),U,23)="S"
IF $PIECE($GET(ND(0)),U,5)'=1
QUIT
+21 SET $PIECE(^PS(55,DFN,"IV",+ON55,0),U,15)=$SELECT($GET(P(15))'="":P(15),$GET(PSGS0XT)'="":PSGS0XT,$PIECE($GET(ZZND),"^",3)'="":$PIECE(ZZND,"^",3),1:$$GETFRQ($PIECE($GET(ND(0)),U,9)))
KILL PSJFRQ,PSJSKED
End DoDot:1
+22 SET $PIECE(^PS(55,DFN,"IV",+ON55,2),U,1,4)=P("LOG")_U_+P("IVRM")_U_U_P("SYRS")
SET $PIECE(^(2),U,8,10)=P("RES")_U_$GET(P("FRES"))_U_$SELECT($GET(VAIN(4)):+VAIN(4),1:"")
+23 SET X=^PS(55,DFN,0)
IF $PIECE(X,"^",7)=""
SET $PIECE(X,"^",7)=$PIECE($PIECE(P("LOG"),"^"),".")
SET $PIECE(X,"^",8)="A"
SET ^(0)=X
DO LOGDFN^PSUHL(DFN)
+24 SET $PIECE(^PS(55,DFN,"IV",+ON55,2),U,11)=+P("CLRK")
+25 if +$GET(P("CLIN"))
SET $PIECE(^PS(55,DFN,"IV",+ON55,"DSS"),"^")=P("CLIN")
+26 if +$GET(P("APPT"))
SET $PIECE(^PS(55,DFN,"IV",+ON55,"DSS"),"^",2)=P("APPT")
+27 if +$GET(P("NINIT"))
SET ^PS(55,DFN,"IV",+ON55,4)=P("NINIT")_U_P("NINITDT")
+28 ;*399-IND
if $GET(P("IND"))]""
SET ^PS(55,DFN,"IV",+ON55,18)=P("IND")
+29 IF '$DATA(^PS(53.45,PSJSYSP,6))
IF ($GET(P("NEWON"))["P")
SET PSJTROPI=P("NEWON")
SET PSJTROPL=$$GETOPI^PSJBCMA5(DFN,PSJTROPI)
+30 IF $GET(^PS(53.45,PSJSYSP,6))!$PIECE($GET(^PS(53.45,PSJSYSP,6,0)),"^",3)
Begin DoDot:1
+31 IF $GET(PSJCOM)
IF $GET(PSJCOMSI)
IF $GET(PSJORD)["V"
MERGE ^TMP("PSJOPI",$JOB,6)=^PS(53.45,PSJSYSP,6)
+32 ;P416 K ^TMP("PSJOPI",$J,6) - comment out since its use the merge below
DO FILEOPI^PSJBCMA5(DFN,ON55)
End DoDot:1
+33 IF '$GET(PSIVCHG)!($GET(PSJREN)&($GET(PSIVCHG)=2))
IF $GET(P("PON"))
IF P("PON")'=ON55
Begin DoDot:1
+34 NEW X
SET X=$SELECT(P("PON")["P":"^PS(53.1,+P(""PON""),12,0)",P("PON")["V"&$GET(PSJREN):"^PS(55,DFN,""IV"",+P(""PON""),5,0)",1:"")
if X=""
QUIT
+35 IF $ORDER(@X)
SET %X=X
SET %Y="^PS(55,"_DFN_",""IV"","_+ON55_",5,"
DO %XY^%RCR
End DoDot:1
+36 FOR DRGT="AD","SOL"
DO PUTD55
+37 KILL DA,DIK
SET DA(1)=DFN
SET DA=+ON55
SET DIK="^PS(55,"_DA(1)_",""IV"","
SET PSIVACT=1
DO IX^DIK
+38 IF $GET(PSJCOM)
IF $GET(PSJCOMSI)
IF $GET(PSJORD)["V"
KILL PSJCOMSI
NEW PSJCHILD,PSJOEORD
SET PSJOEORD=0
FOR
SET PSJOEORD=$ORDER(^PS(55,"ACX",PSJCOM,PSJOEORD))
if 'PSJOEORD
QUIT
Begin DoDot:1
+39 NEW PSJCHILD
SET PSJCHILD=0
FOR
SET PSJCHILD=$ORDER(^PS(55,"ACX",PSJCOM,PSJOEORD,PSJCHILD))
if 'PSJCHILD
QUIT
SET PSJCHILD(+PSJCHILD)=PSJCOM
+40 SET PSJCHILD=0
FOR
SET PSJCHILD=$ORDER(PSJCHILD(PSJCHILD))
if 'PSJCHILD
QUIT
Begin DoDot:2
+41 if PSJCHILD=PSJORD
QUIT
KILL DR,DA,DIE,ORD
SET DR="31////"_$PIECE($GET(P("OPI")),"^",1,2)
SET DA(1)=DFN
+42 NEW ON,ON55
SET (ON,ON55)=+PSJCHILD_"V"
if +$GET(PSJPINIT)'>0
SET PSJPINIT=DUZ
SET PSIVALT=1
SET PSIVAL="COMPLEX ORDER"
DO ENTACT^PSIVAL
Begin DoDot:3
+43 IF $PIECE($GET(^PS(55,DFN,"IV",+ON55,3)),"^")'=$PIECE(P("OPI"),"^")
SET P("FC")="OTHER PRINT INFO^"_$PIECE($GET(^(3)),"^")_U_$PIECE(P("OPI"),"^")
DO GTFC^PSIVORAL
+44 KILL ^PS(55,DFN,"IV",+ON55,10)
+45 MERGE ^PS(55,DFN,"IV",+ON55,10)=^TMP("PSJOPI",$JOB,6)
+46 IF $DATA(^PS(55,DFN,"IV",+ON55,0))
SET ^PS(55,DFN,"IV",+ON55,3)=P("OPI")
DO EN1^PSJHL2(DFN,"XX",ON55)
End DoDot:3
End DoDot:2
End DoDot:1
+47 KILL ^TMP("PSJOPI",$JOB)
+48 QUIT
+49 ;
PUTD55 ; Move drug data from local array into 55
+1 KILL ^PS(55,DFN,"IV",+ON55,DRGT)
SET ^PS(55,DFN,"IV",+ON55,DRGT,0)=$SELECT(DRGT="AD":"^55.02PA",1:"^55.11IPA")
+2 FOR X=0:0
SET X=$ORDER(DRG(DRGT,X))
if 'X
QUIT
Begin DoDot:1
+3 SET Y=^PS(55,DFN,"IV",+ON55,DRGT,0)
SET $PIECE(Y,U,3)=$PIECE(Y,U,3)+1
SET DRG=$PIECE(Y,U,3)
SET $PIECE(Y,U,4)=$PIECE(Y,U,4)+1
+4 SET ^PS(55,DFN,"IV",+ON55,DRGT,0)=Y
SET Y=$PIECE(DRG(DRGT,X),U)_U_$PIECE(DRG(DRGT,X),U,3)
if DRGT="AD"
SET $PIECE(Y,U,3)=$PIECE(DRG(DRGT,X),U,4)
SET ^PS(55,DFN,"IV",+ON55,DRGT,+DRG,0)=Y
End DoDot:1
+5 QUIT
GT55 ; Retrieve data from 55 into local array
+1 KILL DRG,DRGN,P
if '$DATA(ON55)
SET ON55=ON
SET P("REN")=""
SET Y=$GET(^PS(55,DFN,"IV",+ON55,0))
FOR X=1:1:25
SET P(X)=$PIECE(Y,U,X)
+2 SET P("21FLG")=P(21)
+3 SET P("PON")=ON55
SET PSJORIFN=P(21)
SET P(6)=P(6)_U_$PIECE($GET(^VA(200,+P(6),0)),U)
SET (DRG,DRGN)=""
SET P("REM")=$GET(^PS(55,DFN,"IV",+ON55,1))
+4 SET Y=$GET(^PS(55,DFN,"IV",+ON55,2))
SET P("LOG")=$PIECE(Y,U)
SET P("IVRM")=$PIECE(Y,U,2)_U_$PIECE($GET(^PS(59.5,+$PIECE(Y,U,2),0)),U)
+5 SET P("CLRK")=$PIECE(Y,U,11)_U_$PIECE($GET(^VA(200,+$PIECE(Y,U,11),0)),U)
SET P("RES")=$PIECE(Y,U,8)
SET P("FRES")=$PIECE(Y,U,9)
SET P("SYRS")=$PIECE(Y,U,4)
SET P("OPI")=$GET(^PS(55,DFN,"IV",+ON55,3))
+6 SET P("INS")=$GET(^PS(55,DFN,"IV",+ON55,.3))
+7 ;*399-IND
SET P("IND")=$GET(^PS(55,DFN,"IV",+ON55,18))
+8 SET P("CLIN")=$PIECE($GET(^PS(55,DFN,"IV",+ON55,"DSS")),"^")
SET P("APPT")=$PIECE($GET(^PS(55,DFN,"IV",+ON55,"DSS")),"^",2)
+9 SET P("DTYP")=$SELECT(P(4)="":0,P(4)="P"!(P(23)="P")!(P(5)):1,P(4)="H":2,1:3)
+10 if '$DATA(PSJLABEL)
DO GTPC(ON55)
SET ND=$GET(^PS(55,DFN,"IV",+ON55,.2))
SET P("PD")=$SELECT($PIECE(ND,U):$PIECE(ND,U)_U_$$OIDF^PSJLMUT1(+ND)_U_$PIECE($GET(^PS(50.7,+ND,0)),U),1:"")
SET P("DO")=$PIECE(ND,U,2)
SET P("PRY")=$PIECE(ND,U,4)
SET P("NAT")=$PIECE(ND,U,5)
SET (PSJCOM,P("PRNTON"))=$PIECE(ND,U,8)
+11 IF P("PRY")="D"
IF '+P("IVRM")
SET P("IVRM")=+$GET(PSIVSN)_U_$PIECE($GET(^PS(59.5,+$GET(PSIVSN),0)),U)
+12 SET P("MR")=$PIECE(ND,U,3)
SET ND=$GET(^PS(51.2,+P("MR"),0))
SET P("MR")=P("MR")_U_$SELECT($PIECE(ND,U,3)]"":$PIECE(ND,U,3),1:$PIECE(ND,U))
DO GTCUM
+13 DO GTDRG
DO GTOT^PSIVUTL(P(4))
+14 NEW ND2P5
SET ND2P5=$GET(^PS(55,DFN,"IV",+ON55,2.5))
Begin DoDot:1
+15 SET P("DUR")=$PIECE(ND2P5,"^",2)
+16 SET P("LIMIT")=$PIECE(ND2P5,"^",4)
+17 SET P("IVCAT")=$PIECE(ND2P5,"^",5)
End DoDot:1
K ; Kill and exit.
+1 KILL FIL,ND
+2 QUIT
GTDRG ; Get drug info and place in DRG(.
+1 FOR DRGT="AD","SOL"
SET FIL=$SELECT(DRGT="AD":52.6,1:52.7)
FOR Y=0:0
SET Y=$ORDER(^PS(55,DFN,"IV",+ON55,DRGT,Y))
if 'Y
QUIT
Begin DoDot:1
+2 ; naked ref below refers to line above
+3 SET DRG=$GET(^(Y,0))
SET ND=$GET(^PS(FIL,+DRG,0))
SET (DRGI,DRG(DRGT,0))=$GET(DRG(DRGT,0))+1
+4 SET DRG(DRGT,+DRGI)=+DRG_U_$PIECE(ND,U)_U_$PIECE(DRG,U,2)_U_$PIECE(DRG,U,3)_U_$PIECE(ND,U,13)_U_$PIECE(ND,U,11)
End DoDot:1
+5 QUIT
+6 ;
GTCUM ; Retrieve dispensing info.
+1 SET ND=$GET(^PS(55,DFN,"IV",+ON55,9))
SET P("LF")=$PIECE(ND,U)
SET P("LFA")=$PIECE(ND,U,2)
SET P("CUM")=$PIECE(ND,U,3)
+2 QUIT
+3 ;
GTPC(ON) ; Retrieve Provider Comments and create "scratch" fields to edit
+1 QUIT
+2 ;
SETNEW ; Create new order and set
+1 DO NEW55
DO SET55
+2 QUIT
+3 ;
CMPLIM(PSJORD,PSJDSTP1,PSJDSTP2) ; Compare stop date of order against IV Limit
+1 IF $PIECE($GET(^PS(53.1,+PSJORD,0)),"^",25)]""
DO CHKD
if PSJPAO
QUIT 0
+2 IF $GET(PSJDSTP1)
IF $EXTRACT(+PSJDSTP1,1,11)'=$EXTRACT(+P(3),1,11)
IF +PSJDSTP2'=+P(3)
QUIT 1
+3 QUIT 0
+4 ;
LIMSTOP(PSJDSTP1,PSJDSTP2) ; Calculate default stop date using IV Limit
+1 ; Output: PSJDSTP1 - Default stop using duration only
+2 ; PSJDSTP2 - Default stop using duration and IV parameters for time
+3 SET PSIVLIM=$$GETLIM^PSIVCAL(DFN,PSJORD)
+4 IF 'PSIVLIM
IF PSIVLIM]""
SET PSIVLIM=$$GETMIN^PSIVCAL(PSIVLIM,DFN,PSJORD)
+5 IF PSIVLIM]""
Begin DoDot:1
+6 SET MINS=$$GETMIN^PSIVCAL(PSIVLIM,DFN,PSJORD)
SET PSJDSTP1=$$FMADD^XLFDT(P(2),,,MINS)
+7 SET X=$PIECE(PSJDSTP1,".")
SET PSJDSTP2=X_$SELECT($PIECE($GET(PSIVSITE),"^",14)="":.2359,1:"."_$PIECE(PSIVSITE,"^",14))
End DoDot:1
+8 QUIT
+9 ;
GETFRQ(PSJSKED) ;Get frequency using name of schedule
+1 IF PSJSKED=""
KILL PSJSKED
QUIT ""
+2 SET (PSJCNTX,PSJFRQ)=""
+3 IF $DATA(^PS(51.1,"APPSJ",PSJSKED))
FOR
SET PSJCNTX=$ORDER(^PS(51.1,"APPSJ",PSJSKED,PSJCNTX))
if PSJCNTX=""
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^PS(51.1,PSJCNTX,0)),U,3)'=""
SET PSJFRQ=$PIECE(^PS(51.1,PSJCNTX,0),U,3)
End DoDot:1
if $GET(PSJFRQ)'=""
QUIT
+5 KILL PSJCNTX
+6 QUIT PSJFRQ
+7 ;
CHKD ;Check for a previous active order and compare the duration
+1 NEW PSJPO,A,PSJDUR
+2 SET PSJDUR=$$GETLIM^PSIVCAL(DFN,PSJORD)
+3 SET PSJPAO=0
SET PSJPO=PSJORD
CHKDR SET PSJPO=$PIECE($GET(^PS(53.1,+PSJPO,0)),"^",25)
if PSJPO=""
QUIT
+1 IF PSJPO["P"
GOTO CHKDR
+2 IF PSJPO["V"
SET PSIVLIM=$$GETLIM^PSIVCAL(DFN,PSJPO)
IF PSJDUR'=PSIVLIM
SET PSJPAO=1
QUIT
+3 GOTO CHKDR
+4 ;
LOGOPI(DFN,ON55) ; Log OPI activity into activity log
+1 NEW PSJPICHK
+2 IF ON55["V"
Begin DoDot:1
+3 IF ($GET(P("PON"))["V")
IF ($GET(ON55)["V")
IF (ON55'=P("PON"))
Begin DoDot:2
+4 KILL PSJARRY1,PSJARRY2
MERGE PSJARRY1=^PS(53.45,+$GET(PSJSYSP),6),PSJARRY2=^PS(55,DFN,"IV",+P("PON"),10)
SET PSJPICHK='$$DIFFAR^PSJBCMA5(.PSJARRY1,.PSJARRY2)
End DoDot:2
+5 if $GET(PSJPICHK)
QUIT
+6 NEW PSIVALCK,PSIVRA,PSIVLN,PSIVLSTA
SET PSIVLN=$ORDER(^PS(55,DFN,"IV",+ON55,"A",""),-1)+1
+7 KILL PSJARRY1,PSJARRY2
SET PSJARRY1=""
SET PSJARRY2=""
MERGE PSJARRY1=^PS(53.45,+$GET(PSJSYSP),6),PSJARRY2=^PS(55,DFN,"IV",+ON55,10)
if '$$DIFFAR^PSJBCMA5(.PSJARRY1,.PSJARRY2)
QUIT
+8 SET P("FC")="OTHER PRINT INFO^"_$PIECE($GET(^PS(55,DFN,"IV",+ON55,3)),"^")_U_$PIECE($GET(P("OPI")),"^")
SET PSIVALCK="OPI"
SET PSIVREA="E"
DO LOG^PSIVORAL
End DoDot:1
+9 KILL PSJARRY1,PSJARRY2
+10 QUIT
