PSJCOMV ;BIR/CML3-FINISH COMPLEX IV ORDERS ENTERED THROUGH OE/RR ;02 Feb 2001 12:20 PM
;;5.0; INPATIENT MEDICATIONS ;**110,127**;16 DEC 97
;
; Reference to ^PS(55 is supported by DBIA 2191.
; Reference to ^%DTC is supported by DBIA 10000..
; Reference to ^DIR is supported by DBIA 10026.
;
;
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"
;I PSIVCHG D NEWIV Q
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")
F X=0,2,4,8,9 S ^TMP("PSJCOM",$J,+ON,X)=ND(X)
S:'+$G(^TMP("PSJCOM",$J,+ON,.2)) $P(^(.2),U,1,3)=+P("PD")_U_P("DO")_U_$G(P("NAT"))
F DRGT="AD","SOL" D:$D(DRG(DRGT)) PTD531
;K DA,DIK S PSGS0Y=P(11),PSGS0XT=P(15),DA=+ON,DIK="^PS(53.1," D IX^DIK K DA,DIK,PSGS0Y,PSGS0XT,ND,^PS(53.1,"AS","P",DFN,+ON)
;K:P(17)="A" ^PS(53.1,"AS","N",DFN,+ON)
I '+$P(PSJSYSP0,"^",9) D NEWNVAL^PSJCOM(ON,$S(+PSJSYSU=3:22005,1:22000))
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
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
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
;K DA,DIK S PSGS0Y=P(11),PSGS0XT=P(15),DA=+ON,DIK="^PS(53.1," D IX^DIK K DA,DIK,PSGS0Y,PSGS0XT,ND,^PS(53.1,"AS","P",DFN,+ON)
;K:P(17)="A" ^PS(53.1,"AS","N",DFN,+ON)
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 X=^PS(55,DFN,0) I $P(X,"^",7)="" S $P(X,"^",7)=$P($P(P("LOG"),"^"),"."),$P(X,"^",8)="A",^(0)=X
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
;S:'$D(PSIVUP) PSIVUP=+$$GTPCI^PSIVUTL K ^PS(55,DFN,"IV",+ON55,5) I $O(^PS(53.45,PSIVUP,4,0)) S %X="^PS(53.45,"_PSIVUP_",4,",%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
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
PSJCOMV ;BIR/CML3-FINISH COMPLEX IV ORDERS ENTERED THROUGH OE/RR ;02 Feb 2001 12:20 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;**110,127**;16 DEC 97
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA 2191.
+4 ; Reference to ^%DTC is supported by DBIA 10000..
+5 ; Reference to ^DIR is supported by DBIA 10026.
+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 ;I PSIVCHG D NEWIV Q
+5 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))
+6 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")
+7 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:"")
+8 IF +$GET(P("CLIN"))
SET ^TMP("PSJCOM",$JOB,+ON,"DSS")=P("CLIN")
+9 FOR X=0,2,4,8,9
SET ^TMP("PSJCOM",$JOB,+ON,X)=ND(X)
+10 IF '+$GET(^TMP("PSJCOM",$JOB,+ON,.2))
SET $PIECE(^(.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 ;K DA,DIK S PSGS0Y=P(11),PSGS0XT=P(15),DA=+ON,DIK="^PS(53.1," D IX^DIK K DA,DIK,PSGS0Y,PSGS0XT,ND,^PS(53.1,"AS","P",DFN,+ON)
+13 ;K:P(17)="A" ^PS(53.1,"AS","N",DFN,+ON)
+14 IF '+$PIECE(PSJSYSP0,"^",9)
DO NEWNVAL^PSJCOM(ON,$SELECT(+PSJSYSU=3:22005,1:22000))
+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 IF '$DATA(^TMP("PSJCOM",$JOB,+ON))
MERGE ^TMP("PSJCOM",$JOB,+ON)=^PS(53.1,+ON)
Begin DoDot:1
+3 NEW CHILD,ORDER
SET ORDER=0
FOR
SET ORDER=$ORDER(^PS(53.1,"ACX",PSJCOM,ORDER))
IF 'ORDER
QUIT
Begin DoDot:2
+4 IF '$DATA(^TMP("PSJCOM",$JOB,+ORDER))
MERGE ^TMP("PSJCOM",$JOB,+ORDER)=^PS(53.1,+ORDER)
End DoDot:2
End DoDot:1
+5 IF ON["P"
Begin DoDot:1
+6 SET P(17)="A"
+7 ;Used in ACTLOG to update activity log in ^TMP
SET PSGORDP=ON
+8 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)
+9 ;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
+10 DO NEWNVAL^PSJCOM(ON,(PSJSYSU*10+22000))
WRITE "."
+11 SET VND4=$SELECT('$DATA(^TMP("PSJCOM2",$JOB,+ON)):$GET(^TMP("PSJCOM",$JOB,+ON,4)),1:$GET(^TMP("PSJCOM2",$JOB,+ON,4)))
+12 SET VND2P5=$$GETDUR^PSJLIVMD(DFN,ON,$EXTRACT(ON,$LENGTH(ON)),1)
IF VND2P5]""
Begin DoDot:1
+13 IF '$DATA(^TMP("PSJCOM2",$JOB,+ON))
SET ^TMP("PSJCOM",$JOB,+ON,2.5)="^"_VND2P5
QUIT
+14 IF $DATA(^TMP("PSJCOM2",$JOB,+ON))
SET ^TMP("PSJCOM2",$JOB,+ON,2.5)="^"_VND2P5
End DoDot:1
+15 IF $GET(PSGRSD)
Begin DoDot:1
+16 SET PSGRSD=$$ENDTC^PSGMI(PSGRSD)
DO NEWNVAL^PSJCOM(ON,6090,"Requested Start Date",PSGRSD)
+17 SET PSGRFD=$$ENDTC^PSGMI(PSGRFD)
DO NEWNVAL^PSJCOM(ON,6090,"Requested Stop Date",PSGRFD)
End DoDot:1
+18 KILL PSGRSD,PSGRFD,PSGALFN
+19 NEW X
SET X=0
IF $GET(PSGONF)
IF (+$GET(PSGODDD(1))'<+$GET(PSGONF))
SET X=1
+20 ; D EN^PSGPEN(+ON)
IF +PSJSYSU=3
IF ON'["O"
IF $SELECT(X:0,'$PIECE(VND4,"^",16):1,1:$PIECE(VND4,"^",15))
+21 IF '$PIECE(VND4,U,+PSJSYSU=3+9)
SET $PIECE(VND4,U,+PSJSYSU=3+9)=+$PIECE(VND4,U,+PSJSYSU=3+9)
+22 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
+23 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
+24 IF '$DATA(PSJSPEED)
WRITE !
WRITE !,"ORDER VERIFIED.",!
+25 IF '$DATA(PSJSPEED)
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+26 SET VALMBCK="Q"
+27 SET ^TMP("PSJCOM",$JOB)="A"
IF $DATA(^TMP("PSJCOM2",$JOB,+ON))
SET ^TMP("PSJCOM2",$JOB)="A"
QUIT
+28 ;
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 ;K DA,DIK S PSGS0Y=P(11),PSGS0XT=P(15),DA=+ON,DIK="^PS(53.1," D IX^DIK K DA,DIK,PSGS0Y,PSGS0XT,ND,^PS(53.1,"AS","P",DFN,+ON)
+13 ;K:P(17)="A" ^PS(53.1,"AS","N",DFN,+ON)
+14 DO EN^VALM("PSJ LM IV INPT ACTIVE")
+15 QUIT
+16 ;
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 ;S X=^PS(55,DFN,0) I $P(X,"^",7)="" S $P(X,"^",7)=$P($P(P("LOG"),"^"),"."),$P(X,"^",8)="A",^(0)=X
+9 SET $PIECE(^TMP("PSJCOM2",$JOB,+ON,2),U,11)=+P("CLRK")
+10 IF +$GET(P("CLIN"))
SET ^TMP("PSJCOM2",$JOB,+ON,"DSS")=P("CLIN")
+11 IF +$GET(P("NINIT"))
SET ^TMP("PSJCOM2",$JOB,+ON,4)=P("NINIT")_U_P("NINITDT")
+12 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
+13 IF +PSJSYSU=1
SET $PIECE(^TMP("PSJCOM2",$JOB,+ON,4),"^",10)=1
+14 ;S:'$D(PSIVUP) PSIVUP=+$$GTPCI^PSIVUTL K ^PS(55,DFN,"IV",+ON55,5) I $O(^PS(53.45,PSIVUP,4,0)) S %X="^PS(53.45,"_PSIVUP_",4,",%Y="^PS(55,"_DFN_",""IV"","_+ON55_",5," D %XY^%RCR
+15 FOR DRGT="AD","SOL"
DO PUTD55
+16 ;K DA,DIK S DA(1)=DFN,DA=+ON55,DIK="^PS(55,"_DA(1)_",""IV"",",PSIVACT=1 D IX^DIK
+17 QUIT
+18 ;
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
