- 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 Feb 18, 2025@23:32:55 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
