PSJCOMV ;BIR/CML-FINISH COMPLEX IV ORDERS ENTERED THROUGH OE/RR ;02 Feb 2001 12:20 PM
;;5.0;INPATIENT MEDICATIONS;**110,127,267,257,281,416,437**;16 DEC 97;Build 2
;
; Reference to ^%DTC is supported by DBIA 10000
; Reference to ^DIR is supported by DBIA 10026
; Reference to ^TMP("PSODAOC",$J supported by DBIA 6071
;
;
IV ; Move IV data in local variables to ^TMP
Q:'PSJCOM Q:ON'["P"
M ^TMP("PSJCOM",$J,+ON)=^PS(53.1,+ON)
S P(17)="N"
K ND S ND(0)=+ON_U_+P(6)_U_$S(+P("MR"):+P("MR"),1:"")_U_$P(P("OT"),U)_U_U_U_"C",$P(ND(0),U,9)=P(17),$P(ND(0),U,21)=$G(P(21))
S $P(ND(0),U,14,16)=P("LOG")_U_DFN_U_P("LOG"),$P(ND(0),U,24,26)=$G(P("RES"))_U_$G(P("OLDON"))_U_$G(P("NEWON")) S ND(2)=P(9)_U_P(2)_U_U_P(3)_U_P(11)_U_P(15),$P(ND(4),U,7,9)=+P("CLRK")_U_U_P("REN")
S ND(8)=P(4)_U_P(23)_U_P("SYRS")_U_P(5)_U_P(8)_"^^"_P(7),ND(9)=$S($L(P("REM")_P("OPI")):P("REM")_U_P("OPI"),1:"")
S:+$G(P("CLIN")) ^TMP("PSJCOM",$J,+ON,"DSS")=P("CLIN")
S:+$G(P("APPT")) $P(^TMP("PSJCOM",$J,+ON,"DSS"),U,2)=P("APPT") ;p437 testing
F X=0,2,4,8,9 S ^TMP("PSJCOM",$J,+ON,X)=ND(X)
S $P(^TMP("PSJCOM",$J,+ON,.2),U,1,3)=+P("PD")_U_P("DO")_U_$G(P("NAT"))
F DRGT="AD","SOL" D:$D(DRG(DRGT)) PTD531
I '+$P(PSJSYSP0,"^",9) D NEWNVAL^PSJCOM(ON,$S(+PSJSYSU=3:22005,1:22000))
S ^TMP("PSODAOC",$J,"IP IEN")=ON
D SETOC^PSJNEWOC(ON)
I +PSJSYSU=3,+$P(PSJSYSP0,U,9) D VFYIV Q
I +PSJSYSU=1,+$P(PSJSYSP0,U,9),$G(PSJIRNF) D VFYIV
I $G(PSIVENO),($P(^PS(53.1,+PSJORD,0),U,9)="N") D EN^VALM("PSJ LM IV INPT ACTIVE")
Q
;
VFYIV ;
Q:'PSJCOM
D KILL531^PSJIMO1(DFN,"",+ON)
I '$D(^TMP("PSJCOM",$J,+ON)) M ^TMP("PSJCOM",$J,+ON)=^PS(53.1,+ON) D
. N CHILD,ORDER S ORDER=0 F S ORDER=$O(^PS(53.1,"ACX",PSJCOM,ORDER)) Q:'ORDER D
.. I '$D(^TMP("PSJCOM",$J,+ORDER)) M ^TMP("PSJCOM",$J,+ORDER)=^PS(53.1,+ORDER)
I ON["P" D
. S P(17)="A"
. S PSGORDP=ON ;Used in ACTLOG to update activity log in ^TMP
. NEW PSGX S PSGX=$S($D(^TMP("PSJCOM2",$J,+ON,2.5)):$G(^TMP("PSJCOM2",$J,+ON,2.5)),1:$G(^TMP("PSJCOM2",$J,+ON,2.5))),PSGRSD=$P(PSGX,U),PSGRFD=$P(PSGX,U,3)
. S:$D(^TMP("PSJCOM2",$J,+ON,0)) $P(^TMP("PSJCOM2",$J,+ON,0),"^",9)=P(17) S:'$D(^TMP("PSJCOM2",$J,+ON,0)) $P(^TMP("PSJCOM",$J,+ON,0),"^",9)=P(17) W "." ;D ^PSGOT
D NEWNVAL^PSJCOM(ON,(PSJSYSU*10+22000)) W "."
S VND4=$S('$D(^TMP("PSJCOM2",$J,+ON)):$G(^TMP("PSJCOM",$J,+ON,4)),1:$G(^TMP("PSJCOM2",$J,+ON,4)))
S VND2P5=$$GETDUR^PSJLIVMD(DFN,ON,$E(ON,$L(ON)),1) I VND2P5]"" D
. S:'$D(^TMP("PSJCOM2",$J,+ON)) ^TMP("PSJCOM",$J,+ON,2.5)="^"_VND2P5 Q
. S:$D(^TMP("PSJCOM2",$J,+ON)) ^TMP("PSJCOM2",$J,+ON,2.5)="^"_VND2P5
I $G(PSGRSD) D
. S PSGRSD=$$ENDTC^PSGMI(PSGRSD) D NEWNVAL^PSJCOM(ON,6090,"Requested Start Date",PSGRSD)
. S PSGRFD=$$ENDTC^PSGMI(PSGRFD) D NEWNVAL^PSJCOM(ON,6090,"Requested Stop Date",PSGRFD)
K PSGRSD,PSGRFD,PSGALFN
NEW X S X=0 I $G(PSGONF),(+$G(PSGODDD(1))'<+$G(PSGONF)) S X=1
I +PSJSYSU=3,ON'["O",$S(X:0,'$P(VND4,"^",16):1,1:$P(VND4,"^",15)) ; D EN^PSGPEN(+ON)
S:'$P(VND4,U,+PSJSYSU=3+9) $P(VND4,U,+PSJSYSU=3+9)=+$P(VND4,U,+PSJSYSU=3+9)
S:$P(VND4,"^",15)&'$P(VND4,"^",16) $P(VND4,"^",15)="" S:$P(VND4,"^",18)&'$P(VND4,"^",19) $P(VND4,"^",18)="" S:$P(VND4,"^",22)&'$P(VND4,"^",23) $P(VND4,"^",22)="" S $P(VND4,"^",PSJSYSU,PSJSYSU+1)=DUZ_"^"_PSGDT,^TMP("PSJCOM",$J,+ON,4)=VND4
S:'$D(^TMP("PSJCOM2",$J,+ON)) ^TMP("PSJCOM",$J,+ON,4)=VND4 S:$D(^TMP("PSJCOM2",$J,+ON)) ^TMP("PSJCOM2",$J,+ON,4)=VND4
S ^TMP("PSODAOC",$J,"IP IEN")=PSJORD
W:'$D(PSJSPEED) ! W !,"ORDER VERIFIED.",!
I '$D(PSJSPEED) K DIR S DIR(0)="E" D ^DIR K DIR
S VALMBCK="Q"
S ^TMP("PSJCOM",$J)="A" S:$D(^TMP("PSJCOM2",$J,+ON)) ^TMP("PSJCOM2",$J)="A" Q
;
PTD531 ; Move drug data from local array into ^TMP
K ^TMP("PSJCOM",$J,DRGT) S ^TMP("PSJCOM",$J,+ON,DRGT,0)=$S(DRGT="AD":"^53.157^0^0",1:"^53.158^0^0")
F X=0:0 S X=$O(DRG(DRGT,X)) Q:'X D
.S X1=$P(DRG(DRGT,X),U),Y=^TMP("PSJCOM",$J,+ON,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 ^TMP("PSJCOM",$J,+ON,DRGT,0)=Y,Y=+X1_U_$P(DRG(DRGT,X),U,3) S:DRGT="AD" $P(Y,U,3)=$P(DRG(DRGT,X),U,4) S ^TMP("PSJCOM",$J,+ON,DRGT,+DRG,0)=Y
Q
;
NEWIV ;Create new IV order in appropriate file format
M ^TMP("PSJCOM2",$J,+ON)=^PS(53.1,+ON)
S $P(^TMP("PSJCOM",$J,+ON,0),"^",9)="DE",P("OLDON")=+ON_"P",P("RES")="E"
I +$P(PSJSYSP0,U,9) D NEWAIV Q
S ND(0)=+ON_U_+P(6)_U_$S(+P("MR"):+P("MR"),1:"")_U_$P(P("OT"),U)_U_U_U_"C",$P(ND(0),U,9)=P(17),$P(ND(0),U,21)=$G(P(21))
S $P(ND(0),U,14,16)=P("LOG")_U_DFN_U_P("LOG"),$P(ND(0),U,24,26)=$G(P("RES"))_U_$G(P("OLDON"))_U_$G(P("NEWON")) S ND(2)=P(9)_U_P(2)_U_U_P(3)_U_P(11)_U_P(15),$P(ND(4),U,7,9)=+P("CLRK")_U_U_P("REN")
S ND(8)=P(4)_U_P(23)_U_P("SYRS")_U_P(5)_U_P(8)_"^^"_P(7),ND(9)=$S($L(P("REM")_P("OPI")):P("REM")_U_P("OPI"),1:"")
S:+$G(P("CLIN")) ^TMP("PSJCOM2",$J,+ON,"DSS")=P("CLIN")
F X=0,2,4,8,9 S ^TMP("PSJCOM2",$J,+ON,X)=ND(X)
S:'+$G(^TMP("PSJCOM2",$J,+ON,.2)) $P(^(.2),U,1,3)=+P("PD")_U_P("DO")_U_$G(P("NAT"))
I $G(P("PRNTON"))]"" S $P(^TMP("PSJCOM2",$J,+ON,.2),"^",8)=$G(P("PRNTON"))
F DRGT="AD","SOL" D:$D(DRG(DRGT)) PTD5312
D EN^VALM("PSJ LM IV INPT ACTIVE")
Q
;
PTD5312 ; Move drug data from local array into ^TMP
K ^TMP("PSJCOM2",$J,DRGT) S ^TMP("PSJCOM2",$J,+ON,DRGT,0)=$S(DRGT="AD":"^53.157^0^0",1:"^53.158^0^0")
F X=0:0 S X=$O(DRG(DRGT,X)) Q:'X D
.S X1=$P(DRG(DRGT,X),U),Y=^TMP("PSJCOM2",$J,+ON,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 ^TMP("PSJCOM2",$J,+ON,DRGT,0)=Y,Y=+X1_U_$P(DRG(DRGT,X),U,3) S:DRGT="AD" $P(Y,U,3)=$P(DRG(DRGT,X),U,4) S ^TMP("PSJCOM2",$J,+ON,DRGT,+DRG,0)=Y
Q
;
NEWAIV ;Creates new IV order in the file 55 format
N DA,DIK,ND,PSIVACT
I '$D(PSGDT) D NOW^%DTC S PSGDT=+$E(%,1,12)
S:'$D(P(21)) (P(21),P("21FLG"))="" S ND(0)=+ON,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"))
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,3,.2,.3 S ^TMP("PSJCOM2",$J,+ON,X)=ND(X)
S $P(^TMP("PSJCOM2",$J,+ON,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 $P(^TMP("PSJCOM2",$J,+ON,2),U,11)=+P("CLRK")
S:+$G(P("CLIN")) ^TMP("PSJCOM2",$J,+ON,"DSS")=P("CLIN")
S:+$G(P("NINIT")) ^TMP("PSJCOM2",$J,+ON,4)=P("NINIT")_U_P("NINITDT")
I +PSJSYSU=3 S $P(^TMP("PSJCOM2",$J,+ON,4),"^",4)=DUZ,$P(^TMP("PSJCOM2",$J,+ON,4),"^",5)=PSGDT,$P(^TMP("PSJCOM2",$J,+ON,4),"^",9)=1
I +PSJSYSU=1 S $P(^TMP("PSJCOM2",$J,+ON,4),"^",10)=1
F DRGT="AD","SOL" D PUTD55
Q
;
PUTD55 ; Move drug data from local array into 55
K ^TMP("PSJCOM2",$J,+ON,DRGT) S ^TMP("PSJCOM2",$J,+ON,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=^TMP("PSJCOM2",$J,+ON,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 ^TMP("PSJCOM2",$J,+ON,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 ^TMP("PSJCOM2",$J,+ON,DRGT,+DRG,0)=Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJCOMV 7030 printed Sep 23, 2025@19:42:39 Page 2
PSJCOMV ;BIR/CML-FINISH COMPLEX IV ORDERS ENTERED THROUGH OE/RR ;02 Feb 2001 12:20 PM
+1 ;;5.0;INPATIENT MEDICATIONS;**110,127,267,257,281,416,437**;16 DEC 97;Build 2
+2 ;
+3 ; Reference to ^%DTC is supported by DBIA 10000
+4 ; Reference to ^DIR is supported by DBIA 10026
+5 ; Reference to ^TMP("PSODAOC",$J supported by DBIA 6071
+6 ;
+7 ;
IV ; Move IV data in local variables to ^TMP
+1 if 'PSJCOM
QUIT
if ON'["P"
QUIT
+2 MERGE ^TMP("PSJCOM",$JOB,+ON)=^PS(53.1,+ON)
+3 SET P(17)="N"
+4 KILL ND
SET ND(0)=+ON_U_+P(6)_U_$SELECT(+P("MR"):+P("MR"),1:"")_U_$PIECE(P("OT"),U)_U_U_U_"C"
SET $PIECE(ND(0),U,9)=P(17)
SET $PIECE(ND(0),U,21)=$GET(P(21))
+5 SET $PIECE(ND(0),U,14,16)=P("LOG")_U_DFN_U_P("LOG")
SET $PIECE(ND(0),U,24,26)=$GET(P("RES"))_U_$GET(P("OLDON"))_U_$GET(P("NEWON"))
SET ND(2)=P(9)_U_P(2)_U_U_P(3)_U_P(11)_U_P(15)
SET $PIECE(ND(4),U,7,9)=+P("CLRK")_U_U_P("REN")
+6 SET ND(8)=P(4)_U_P(23)_U_P("SYRS")_U_P(5)_U_P(8)_"^^"_P(7)
SET ND(9)=$SELECT($LENGTH(P("REM")_P("OPI")):P("REM")_U_P("OPI"),1:"")
+7 if +$GET(P("CLIN"))
SET ^TMP("PSJCOM",$JOB,+ON,"DSS")=P("CLIN")
+8 ;p437 testing
if +$GET(P("APPT"))
SET $PIECE(^TMP("PSJCOM",$JOB,+ON,"DSS"),U,2)=P("APPT")
+9 FOR X=0,2,4,8,9
SET ^TMP("PSJCOM",$JOB,+ON,X)=ND(X)
+10 SET $PIECE(^TMP("PSJCOM",$JOB,+ON,.2),U,1,3)=+P("PD")_U_P("DO")_U_$GET(P("NAT"))
+11 FOR DRGT="AD","SOL"
if $DATA(DRG(DRGT))
DO PTD531
+12 IF '+$PIECE(PSJSYSP0,"^",9)
DO NEWNVAL^PSJCOM(ON,$SELECT(+PSJSYSU=3:22005,1:22000))
+13 SET ^TMP("PSODAOC",$JOB,"IP IEN")=ON
+14 DO SETOC^PSJNEWOC(ON)
+15 IF +PSJSYSU=3
IF +$PIECE(PSJSYSP0,U,9)
DO VFYIV
QUIT
+16 IF +PSJSYSU=1
IF +$PIECE(PSJSYSP0,U,9)
IF $GET(PSJIRNF)
DO VFYIV
+17 IF $GET(PSIVENO)
IF ($PIECE(^PS(53.1,+PSJORD,0),U,9)="N")
DO EN^VALM("PSJ LM IV INPT ACTIVE")
+18 QUIT
+19 ;
VFYIV ;
+1 if 'PSJCOM
QUIT
+2 DO KILL531^PSJIMO1(DFN,"",+ON)
+3 IF '$DATA(^TMP("PSJCOM",$JOB,+ON))
MERGE ^TMP("PSJCOM",$JOB,+ON)=^PS(53.1,+ON)
Begin DoDot:1
+4 NEW CHILD,ORDER
SET ORDER=0
FOR
SET ORDER=$ORDER(^PS(53.1,"ACX",PSJCOM,ORDER))
if 'ORDER
QUIT
Begin DoDot:2
+5 IF '$DATA(^TMP("PSJCOM",$JOB,+ORDER))
MERGE ^TMP("PSJCOM",$JOB,+ORDER)=^PS(53.1,+ORDER)
End DoDot:2
End DoDot:1
+6 IF ON["P"
Begin DoDot:1
+7 SET P(17)="A"
+8 ;Used in ACTLOG to update activity log in ^TMP
SET PSGORDP=ON
+9 NEW PSGX
SET PSGX=$SELECT($DATA(^TMP("PSJCOM2",$JOB,+ON,2.5)):$GET(^TMP("PSJCOM2",$JOB,+ON,2.5)),1:$GET(^TMP("PSJCOM2",$JOB,+ON,2.5)))
SET PSGRSD=$PIECE(PSGX,U)
SET PSGRFD=$PIECE(PSGX,U,3)
+10 ;D ^PSGOT
if $DATA(^TMP("PSJCOM2",$JOB,+ON,0))
SET $PIECE(^TMP("PSJCOM2",$JOB,+ON,0),"^",9)=P(17)
if '$DATA(^TMP("PSJCOM2",$JOB,+ON,0))
SET $PIECE(^TMP("PSJCOM",$JOB,+ON,0),"^",9)=P(17)
WRITE "."
End DoDot:1
+11 DO NEWNVAL^PSJCOM(ON,(PSJSYSU*10+22000))
WRITE "."
+12 SET VND4=$SELECT('$DATA(^TMP("PSJCOM2",$JOB,+ON)):$GET(^TMP("PSJCOM",$JOB,+ON,4)),1:$GET(^TMP("PSJCOM2",$JOB,+ON,4)))
+13 SET VND2P5=$$GETDUR^PSJLIVMD(DFN,ON,$EXTRACT(ON,$LENGTH(ON)),1)
IF VND2P5]""
Begin DoDot:1
+14 if '$DATA(^TMP("PSJCOM2",$JOB,+ON))
SET ^TMP("PSJCOM",$JOB,+ON,2.5)="^"_VND2P5
QUIT
+15 if $DATA(^TMP("PSJCOM2",$JOB,+ON))
SET ^TMP("PSJCOM2",$JOB,+ON,2.5)="^"_VND2P5
End DoDot:1
+16 IF $GET(PSGRSD)
Begin DoDot:1
+17 SET PSGRSD=$$ENDTC^PSGMI(PSGRSD)
DO NEWNVAL^PSJCOM(ON,6090,"Requested Start Date",PSGRSD)
+18 SET PSGRFD=$$ENDTC^PSGMI(PSGRFD)
DO NEWNVAL^PSJCOM(ON,6090,"Requested Stop Date",PSGRFD)
End DoDot:1
+19 KILL PSGRSD,PSGRFD,PSGALFN
+20 NEW X
SET X=0
IF $GET(PSGONF)
IF (+$GET(PSGODDD(1))'<+$GET(PSGONF))
SET X=1
+21 ; D EN^PSGPEN(+ON)
IF +PSJSYSU=3
IF ON'["O"
IF $SELECT(X:0,'$PIECE(VND4,"^",16):1,1:$PIECE(VND4,"^",15))
+22 if '$PIECE(VND4,U,+PSJSYSU=3+9)
SET $PIECE(VND4,U,+PSJSYSU=3+9)=+$PIECE(VND4,U,+PSJSYSU=3+9)
+23 if $PIECE(VND4,"^",15)&'$PIECE(VND4,"^",16)
SET $PIECE(VND4,"^",15)=""
if $PIECE(VND4,"^",18)&'$PIECE(VND4,"^",19)
SET $PIECE(VND4,"^",18)=""
if $PIECE(VND4,"^",22)&'$PIECE(VND4,"^",23)
SET $PIECE(VND4,"^",22)=""
SET $PIECE(VND4,"^",PSJSYSU,PSJSYSU+1)=DUZ_"^"_PSGDT
SET ^TMP("PSJCOM",$JOB,+ON,4)=VND4
+24 if '$DATA(^TMP("PSJCOM2",$JOB,+ON))
SET ^TMP("PSJCOM",$JOB,+ON,4)=VND4
if $DATA(^TMP("PSJCOM2",$JOB,+ON))
SET ^TMP("PSJCOM2",$JOB,+ON,4)=VND4
+25 SET ^TMP("PSODAOC",$JOB,"IP IEN")=PSJORD
+26 if '$DATA(PSJSPEED)
WRITE !
WRITE !,"ORDER VERIFIED.",!
+27 IF '$DATA(PSJSPEED)
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+28 SET VALMBCK="Q"
+29 SET ^TMP("PSJCOM",$JOB)="A"
if $DATA(^TMP("PSJCOM2",$JOB,+ON))
SET ^TMP("PSJCOM2",$JOB)="A"
QUIT
+30 ;
PTD531 ; Move drug data from local array into ^TMP
+1 KILL ^TMP("PSJCOM",$JOB,DRGT)
SET ^TMP("PSJCOM",$JOB,+ON,DRGT,0)=$SELECT(DRGT="AD":"^53.157^0^0",1:"^53.158^0^0")
+2 FOR X=0:0
SET X=$ORDER(DRG(DRGT,X))
if 'X
QUIT
Begin DoDot:1
+3 SET X1=$PIECE(DRG(DRGT,X),U)
SET Y=^TMP("PSJCOM",$JOB,+ON,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 ^TMP("PSJCOM",$JOB,+ON,DRGT,0)=Y
SET Y=+X1_U_$PIECE(DRG(DRGT,X),U,3)
if DRGT="AD"
SET $PIECE(Y,U,3)=$PIECE(DRG(DRGT,X),U,4)
SET ^TMP("PSJCOM",$JOB,+ON,DRGT,+DRG,0)=Y
End DoDot:1
+5 QUIT
+6 ;
NEWIV ;Create new IV order in appropriate file format
+1 MERGE ^TMP("PSJCOM2",$JOB,+ON)=^PS(53.1,+ON)
+2 SET $PIECE(^TMP("PSJCOM",$JOB,+ON,0),"^",9)="DE"
SET P("OLDON")=+ON_"P"
SET P("RES")="E"
+3 IF +$PIECE(PSJSYSP0,U,9)
DO NEWAIV
QUIT
+4 SET ND(0)=+ON_U_+P(6)_U_$SELECT(+P("MR"):+P("MR"),1:"")_U_$PIECE(P("OT"),U)_U_U_U_"C"
SET $PIECE(ND(0),U,9)=P(17)
SET $PIECE(ND(0),U,21)=$GET(P(21))
+5 SET $PIECE(ND(0),U,14,16)=P("LOG")_U_DFN_U_P("LOG")
SET $PIECE(ND(0),U,24,26)=$GET(P("RES"))_U_$GET(P("OLDON"))_U_$GET(P("NEWON"))
SET ND(2)=P(9)_U_P(2)_U_U_P(3)_U_P(11)_U_P(15)
SET $PIECE(ND(4),U,7,9)=+P("CLRK")_U_U_P("REN")
+6 SET ND(8)=P(4)_U_P(23)_U_P("SYRS")_U_P(5)_U_P(8)_"^^"_P(7)
SET ND(9)=$SELECT($LENGTH(P("REM")_P("OPI")):P("REM")_U_P("OPI"),1:"")
+7 if +$GET(P("CLIN"))
SET ^TMP("PSJCOM2",$JOB,+ON,"DSS")=P("CLIN")
+8 FOR X=0,2,4,8,9
SET ^TMP("PSJCOM2",$JOB,+ON,X)=ND(X)
+9 if '+$GET(^TMP("PSJCOM2",$JOB,+ON,.2))
SET $PIECE(^(.2),U,1,3)=+P("PD")_U_P("DO")_U_$GET(P("NAT"))
+10 IF $GET(P("PRNTON"))]""
SET $PIECE(^TMP("PSJCOM2",$JOB,+ON,.2),"^",8)=$GET(P("PRNTON"))
+11 FOR DRGT="AD","SOL"
if $DATA(DRG(DRGT))
DO PTD5312
+12 DO EN^VALM("PSJ LM IV INPT ACTIVE")
+13 QUIT
+14 ;
PTD5312 ; Move drug data from local array into ^TMP
+1 KILL ^TMP("PSJCOM2",$JOB,DRGT)
SET ^TMP("PSJCOM2",$JOB,+ON,DRGT,0)=$SELECT(DRGT="AD":"^53.157^0^0",1:"^53.158^0^0")
+2 FOR X=0:0
SET X=$ORDER(DRG(DRGT,X))
if 'X
QUIT
Begin DoDot:1
+3 SET X1=$PIECE(DRG(DRGT,X),U)
SET Y=^TMP("PSJCOM2",$JOB,+ON,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 ^TMP("PSJCOM2",$JOB,+ON,DRGT,0)=Y
SET Y=+X1_U_$PIECE(DRG(DRGT,X),U,3)
if DRGT="AD"
SET $PIECE(Y,U,3)=$PIECE(DRG(DRGT,X),U,4)
SET ^TMP("PSJCOM2",$JOB,+ON,DRGT,+DRG,0)=Y
End DoDot:1
+5 QUIT
+6 ;
NEWAIV ;Creates new IV order in the file 55 format
+1 NEW DA,DIK,ND,PSIVACT
+2 IF '$DATA(PSGDT)
DO NOW^%DTC
SET PSGDT=+$EXTRACT(%,1,12)
+3 if '$DATA(P(21))
SET (P(21),P("21FLG"))=""
SET ND(0)=+ON
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)
+4 SET ND(.3)=$GET(P("INS"))
+5 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"))
+6 FOR X=0,1,3,.2,.3
SET ^TMP("PSJCOM2",$JOB,+ON,X)=ND(X)
+7 SET $PIECE(^TMP("PSJCOM2",$JOB,+ON,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:"")
+8 SET $PIECE(^TMP("PSJCOM2",$JOB,+ON,2),U,11)=+P("CLRK")
+9 if +$GET(P("CLIN"))
SET ^TMP("PSJCOM2",$JOB,+ON,"DSS")=P("CLIN")
+10 if +$GET(P("NINIT"))
SET ^TMP("PSJCOM2",$JOB,+ON,4)=P("NINIT")_U_P("NINITDT")
+11 IF +PSJSYSU=3
SET $PIECE(^TMP("PSJCOM2",$JOB,+ON,4),"^",4)=DUZ
SET $PIECE(^TMP("PSJCOM2",$JOB,+ON,4),"^",5)=PSGDT
SET $PIECE(^TMP("PSJCOM2",$JOB,+ON,4),"^",9)=1
+12 IF +PSJSYSU=1
SET $PIECE(^TMP("PSJCOM2",$JOB,+ON,4),"^",10)=1
+13 FOR DRGT="AD","SOL"
DO PUTD55
+14 QUIT
+15 ;
PUTD55 ; Move drug data from local array into 55
+1 KILL ^TMP("PSJCOM2",$JOB,+ON,DRGT)
SET ^TMP("PSJCOM2",$JOB,+ON,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=^TMP("PSJCOM2",$JOB,+ON,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 ^TMP("PSJCOM2",$JOB,+ON,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 ^TMP("PSJCOM2",$JOB,+ON,DRGT,+DRG,0)=Y
End DoDot:1
+5 QUIT
