PSJ078B ;BIR/JLC - Check for stop date problems ;08-MAY-02 / 10:34 AM
;;5.0; INPATIENT MEDICATIONS ;**78**;16 DEC 97
;
;Reference to ^PS(55 is supported by DBIA# 2191.
;
XREFS ;
N PSJXD,PSJSTP
S PSJXD=0 F S PSJXD=$O(^PS(55,"AUDS",PSJXD)) Q:'PSJXD D
. S PSJPDFN=0
. F S PSJPDFN=$O(^PS(55,"AUDS",PSJXD,PSJPDFN)) Q:'PSJPDFN D
.. S PSJORD=0
.. F S PSJORD=$O(^PS(55,"AUDS",PSJXD,PSJPDFN,PSJORD)) Q:'PSJORD D
... K XREF S XREF="AUDS" D CHKREF(XREF)
S PSJPDFN=0 F S PSJPDFN=$O(^PS(55,PSJPDFN)) Q:'PSJPDFN D
. S PSJXD=0
. F S PSJXD=$O(^PS(55,PSJPDFN,5,"AUS",PSJXD)) Q:'PSJXD D
.. S PSJORD=0
.. F S PSJORD=$O(^PS(55,PSJPDFN,5,"AUS",PSJXD,PSJORD)) Q:'PSJORD D
... K XREF S XREF="AUS" D CHKREF(XREF)
S PSJPDFN=0 F S PSJPDFN=$O(^PS(55,PSJPDFN)) Q:'PSJPDFN D
. S PSJST="" F S PSJST=$O(^PS(55,PSJPDFN,5,"AU",PSJST)) Q:PSJST="" D
.. S PSJXD=0
.. F S PSJXD=$O(^PS(55,PSJPDFN,5,"AU",PSJST,PSJXD)) Q:'PSJXD D
... S PSJORD=0 F S PSJORD=$O(^PS(55,PSJPDFN,5,"AU",PSJST,PSJXD,PSJORD)) Q:'PSJORD D
.... K XREF S XREF="AU" D CHKREF(XREF)
S PSJXD=0 F S PSJXD=$O(^PS(55,"AUD",PSJXD)) Q:'PSJXD D
. S PSJPDFN=0
. S PSJPDFN=$O(^PS(55,"AUD",PSJXD,PSJPDFN)) Q:'PSJPDFN D
.. S PSJORD=0
.. F S PSJORD=$O(^PS(55,"AUD",PSJXD,PSJPDFN,PSJORD)) Q:'PSJORD D
... K XREF S XREF="AUD" D CHKREF(XREF)
S PSJXD=0 F S PSJXD=$O(^PS(55,"AIVS",PSJXD)) Q:'PSJXD D
. S PSJPDFN=0
. F S PSJPDFN=$O(^PS(55,"AIVS",PSJXD,PSJPDFN)) Q:'PSJPDFN D
.. S PSJORD=0
.. F S PSJORD=$O(^PS(55,"AIVS",PSJXD,PSJPDFN,PSJORD)) Q:'PSJORD D
... K XREF S XREF="AIVS" D CHKREF(XREF)
S PSJPDFN=0 F S PSJPDFN=$O(^PS(55,PSJPDFN)) Q:'PSJPDFN D
. S PSJXD=0
. F S PSJXD=$O(^PS(55,PSJPDFN,"IV","AIS",PSJXD)) Q:'PSJXD D
.. S PSJORD=0
.. F S PSJORD=$O(^PS(55,PSJPDFN,"IV","AIS",PSJXD,PSJORD)) Q:'PSJORD D
... K XREF S XREF="AIS" D CHKREF(XREF)
S PSJPDFN=0 F S PSJPDFN=$O(^PS(55,PSJPDFN)) Q:'PSJPDFN D
. S PSJST=""
. F S PSJST=$O(^PS(55,PSJPDFN,"IV","AIT",PSJST)) Q:PSJST="" D
.. S PSJXD=0
.. F S PSJXD=$O(^PS(55,PSJPDFN,"IV","AIT",PSJST,PSJXD)) Q:'PSJXD D
... S PSJORD=0
... F S PSJORD=$O(^PS(55,PSJPDFN,"IV","AIT",PSJST,PSJXD,PSJORD)) Q:'PSJORD D
.... K XREF S XREF="AIT" D CHKREF(XREF)
S PSJXD=0 F S PSJXD=$O(^PS(55,"AIV",PSJXD)) Q:'PSJXD D
. S PSJPDFN=0
. F S PSJPDFN=$O(^PS(55,"AIV",PSJXD,PSJPDFN)) Q:'PSJPDFN D
.. S PSJORD=0
.. S PSJORD=$O(^PS(55,"AIV",PSJXD,PSJPDFN,PSJORD)) Q:'PSJORD D
... K XREF S XREF="AIV" D CHKREF(XREF)
D XCLEAN
Q
;
CHKREF(REF) ;Check cross references
; UD cross refs
N PSJST,DATES
I REF["AU" D Q
. S PSJND0=$G(^PS(55,PSJPDFN,5,PSJORD,0)),PSJST=$P(PSJND0,"^",7)
. S PSJND2=$G(^PS(55,PSJPDFN,5,PSJORD,2))
. S START=$P(PSJND2,"^",2),STOP=$P(PSJND2,"^",4)
. I REF="AUDS" D Q
.. I START,(START'=PSJXD) D
... S DATES=START_"^"_STOP_"^"_PSJXD_"^^"_PSJST
... S ^XTMP("PSJ XREF",REF,PSJPDFN,PSJORD,PSJXD)=DATES
. I STOP,(STOP'=PSJXD) S DATES=START_"^"_STOP_"^^"_PSJXD_"^"_PSJST D
.. S ^XTMP("PSJ XREF",REF,PSJPDFN,PSJORD,PSJXD)=DATES
; IV cross refs
Q:REF'["AI"
S PSJND0=$G(^PS(55,PSJPDFN,"IV",PSJORD,0))
S PSJND2=$G(^PS(55,PSJPDFN,"IV",PSJORD,2))
S START=$P(PSJND0,"^",2),STOP=$P(PSJND0,"^",3),PSJST=$P(PSJND0,"^",4)
I REF="AIVS" D Q
. I START,(START'=PSJXD) S DATES=START_"^"_STOP_"^"_PSJXD_"^^"_PSJST D
.. S ^XTMP("PSJ XREF",REF,PSJPDFN,PSJORD,PSJXD)=DATES
I STOP,(STOP'=PSJXD) S DATES=START_"^"_STOP_"^^"_PSJXD_"^"_PSJST D
. S ^XTMP("PSJ XREF",REF,PSJPDFN,PSJORD,PSJXD)=DATES
Q
;
XCLEAN ;
N PSJPDFN,PSJORD,PSJSTP,PSJSTRT,OPSJSTRT,OPSJSTP,DATES
S REF="" F S REF=$O(^XTMP("PSJ XREF",REF)) Q:REF="" D
. S PSJPDFN=0
. F S PSJPDFN=$O(^XTMP("PSJ XREF",REF,PSJPDFN)) Q:'PSJPDFN D
.. S PSJORD=0
.. F S PSJORD=$O(^XTMP("PSJ XREF",REF,PSJPDFN,PSJORD)) Q:'PSJORD D
... S PSJXD=0
... F S PSJXD=$O(^XTMP("PSJ XREF",REF,PSJPDFN,PSJORD,PSJXD)) Q:'PSJXD D
.... S DATES=^(PSJXD),PSJSTRT=$P(DATES,"^"),PSJSTP=$P(DATES,"^",2)
.... S OPSJSTRT=$P(DATES,"^",3),OPSJSTP=$P(DATES,"^",4)
.... S PSJST=$P(DATES,"^",5)
.... D @REF
Q
;
UDSTART ; UD Start Date/Time Xrefs ("AUDS")
Q:'PSJSTRT!($L(PSJSTRT)<5)
S $P(^PS(55,PSJPDFN,5,PSJORD,2),"^",2)=+PSJSTRT
AUDS ;
S ^PS(55,"AUDS",+PSJSTRT,PSJPDFN,PSJORD)=""
Q:'$G(OPSJSTRT)
K ^PS(55,"AUDS",OPSJSTRT,PSJPDFN,PSJORD)
Q
UDSTOP ; UD Stop Date/Time Xrefs ("AU","AUS","AUD")
Q:'PSJSTP!($L(PSJSTP)<5)
S $P(^PS(55,PSJPDFN,5,PSJORD,2),"^",4)=+PSJSTP
AU ;
AUS ;
AUD I PSJST?1.2U S ^PS(55,PSJPDFN,5,"AU",PSJST,+PSJSTP,PSJORD)=""
S ^PS(55,PSJPDFN,5,"AUS",+PSJSTP,PSJORD)=""
S ^PS(55,"AUD",+PSJSTP,PSJPDFN,PSJORD)=""
Q:$G(OPSJSTP)=""
I PSJST?1.2U K ^PS(55,PSJPDFN,5,"AU",PSJST,OPSJSTP,PSJORD)
K ^PS(55,PSJPDFN,5,"AUS",OPSJSTP,PSJORD)
K ^PS(55,"AUD",OPSJSTP,PSJPDFN,PSJORD)
UDNVDT ;
S:$G(PSJNVDT)]"" $P(^PS(55,PSJPDFN,5,PSJORD,4),"^",2)=+$G(PSJNVDT)
Q
IVSTART ; IV Start Date/Time Xrefs ("AIVS")
Q:'PSJSTRT!($L(PSJSTP)<5)
S $P(^PS(55,PSJPDFN,"IV",PSJORD,0),"^",2)=+PSJSTRT
AIVS ;
S ^PS(55,"AIVS",+PSJSTRT,PSJPDFN,PSJORD)=""
Q:$G(OPSJSTRT)=""
K ^PS(55,"AIVS",OPSJSTRT,PSJPDFN,PSJORD)
Q
IVSTOP ; IV Stop Date/Time Xrefs ("AIS","AIT","AIV")
Q:'PSJSTP!($L(PSJSTP)<5)
S $P(^PS(55,PSJPDFN,"IV",PSJORD,0),"^",3)=+PSJSTP
AIT ;
AIS ;
AIV I PSJST?1.2U S ^PS(55,PSJPDFN,"IV","AIT",PSJST,+PSJSTP,PSJORD)=""
S ^PS(55,PSJPDFN,"IV","AIS",+PSJSTP,PSJORD)=""
S ^PS(55,"AIV",+PSJSTP,PSJPDFN,PSJORD)=""
I PSJST?1.2U S ^PS(55,PSJPDFN,"IV","AIT",PSJST,+PSJSTP,PSJORD)=""
Q:$G(OPSJSTP)=""
I PSJST?1.2U K ^PS(55,PSJPDFN,"IV","AIT",PSJST,OPSJSTP,PSJORD)
K ^PS(55,PSJPDFN,"IV","AIS",OPSJSTP,PSJORD)
K ^PS(55,"AIV",OPSJSTP,PSJPDFN,PSJORD)
IVNVDT ;
S:$G(PSJNVDT)]"" $P(^PS(55,PSJPDFN,"IV",PSJORD,4),"^",2)=+$G(PSJNVDT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJ078B 5789 printed Dec 13, 2024@02:05:43 Page 2
PSJ078B ;BIR/JLC - Check for stop date problems ;08-MAY-02 / 10:34 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**78**;16 DEC 97
+2 ;
+3 ;Reference to ^PS(55 is supported by DBIA# 2191.
+4 ;
XREFS ;
+1 NEW PSJXD,PSJSTP
+2 SET PSJXD=0
FOR
SET PSJXD=$ORDER(^PS(55,"AUDS",PSJXD))
if 'PSJXD
QUIT
Begin DoDot:1
+3 SET PSJPDFN=0
+4 FOR
SET PSJPDFN=$ORDER(^PS(55,"AUDS",PSJXD,PSJPDFN))
if 'PSJPDFN
QUIT
Begin DoDot:2
+5 SET PSJORD=0
+6 FOR
SET PSJORD=$ORDER(^PS(55,"AUDS",PSJXD,PSJPDFN,PSJORD))
if 'PSJORD
QUIT
Begin DoDot:3
+7 KILL XREF
SET XREF="AUDS"
DO CHKREF(XREF)
End DoDot:3
End DoDot:2
End DoDot:1
+8 SET PSJPDFN=0
FOR
SET PSJPDFN=$ORDER(^PS(55,PSJPDFN))
if 'PSJPDFN
QUIT
Begin DoDot:1
+9 SET PSJXD=0
+10 FOR
SET PSJXD=$ORDER(^PS(55,PSJPDFN,5,"AUS",PSJXD))
if 'PSJXD
QUIT
Begin DoDot:2
+11 SET PSJORD=0
+12 FOR
SET PSJORD=$ORDER(^PS(55,PSJPDFN,5,"AUS",PSJXD,PSJORD))
if 'PSJORD
QUIT
Begin DoDot:3
+13 KILL XREF
SET XREF="AUS"
DO CHKREF(XREF)
End DoDot:3
End DoDot:2
End DoDot:1
+14 SET PSJPDFN=0
FOR
SET PSJPDFN=$ORDER(^PS(55,PSJPDFN))
if 'PSJPDFN
QUIT
Begin DoDot:1
+15 SET PSJST=""
FOR
SET PSJST=$ORDER(^PS(55,PSJPDFN,5,"AU",PSJST))
if PSJST=""
QUIT
Begin DoDot:2
+16 SET PSJXD=0
+17 FOR
SET PSJXD=$ORDER(^PS(55,PSJPDFN,5,"AU",PSJST,PSJXD))
if 'PSJXD
QUIT
Begin DoDot:3
+18 SET PSJORD=0
FOR
SET PSJORD=$ORDER(^PS(55,PSJPDFN,5,"AU",PSJST,PSJXD,PSJORD))
if 'PSJORD
QUIT
Begin DoDot:4
+19 KILL XREF
SET XREF="AU"
DO CHKREF(XREF)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+20 SET PSJXD=0
FOR
SET PSJXD=$ORDER(^PS(55,"AUD",PSJXD))
if 'PSJXD
QUIT
Begin DoDot:1
+21 SET PSJPDFN=0
+22 SET PSJPDFN=$ORDER(^PS(55,"AUD",PSJXD,PSJPDFN))
if 'PSJPDFN
QUIT
Begin DoDot:2
+23 SET PSJORD=0
+24 FOR
SET PSJORD=$ORDER(^PS(55,"AUD",PSJXD,PSJPDFN,PSJORD))
if 'PSJORD
QUIT
Begin DoDot:3
+25 KILL XREF
SET XREF="AUD"
DO CHKREF(XREF)
End DoDot:3
End DoDot:2
End DoDot:1
+26 SET PSJXD=0
FOR
SET PSJXD=$ORDER(^PS(55,"AIVS",PSJXD))
if 'PSJXD
QUIT
Begin DoDot:1
+27 SET PSJPDFN=0
+28 FOR
SET PSJPDFN=$ORDER(^PS(55,"AIVS",PSJXD,PSJPDFN))
if 'PSJPDFN
QUIT
Begin DoDot:2
+29 SET PSJORD=0
+30 FOR
SET PSJORD=$ORDER(^PS(55,"AIVS",PSJXD,PSJPDFN,PSJORD))
if 'PSJORD
QUIT
Begin DoDot:3
+31 KILL XREF
SET XREF="AIVS"
DO CHKREF(XREF)
End DoDot:3
End DoDot:2
End DoDot:1
+32 SET PSJPDFN=0
FOR
SET PSJPDFN=$ORDER(^PS(55,PSJPDFN))
if 'PSJPDFN
QUIT
Begin DoDot:1
+33 SET PSJXD=0
+34 FOR
SET PSJXD=$ORDER(^PS(55,PSJPDFN,"IV","AIS",PSJXD))
if 'PSJXD
QUIT
Begin DoDot:2
+35 SET PSJORD=0
+36 FOR
SET PSJORD=$ORDER(^PS(55,PSJPDFN,"IV","AIS",PSJXD,PSJORD))
if 'PSJORD
QUIT
Begin DoDot:3
+37 KILL XREF
SET XREF="AIS"
DO CHKREF(XREF)
End DoDot:3
End DoDot:2
End DoDot:1
+38 SET PSJPDFN=0
FOR
SET PSJPDFN=$ORDER(^PS(55,PSJPDFN))
if 'PSJPDFN
QUIT
Begin DoDot:1
+39 SET PSJST=""
+40 FOR
SET PSJST=$ORDER(^PS(55,PSJPDFN,"IV","AIT",PSJST))
if PSJST=""
QUIT
Begin DoDot:2
+41 SET PSJXD=0
+42 FOR
SET PSJXD=$ORDER(^PS(55,PSJPDFN,"IV","AIT",PSJST,PSJXD))
if 'PSJXD
QUIT
Begin DoDot:3
+43 SET PSJORD=0
+44 FOR
SET PSJORD=$ORDER(^PS(55,PSJPDFN,"IV","AIT",PSJST,PSJXD,PSJORD))
if 'PSJORD
QUIT
Begin DoDot:4
+45 KILL XREF
SET XREF="AIT"
DO CHKREF(XREF)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+46 SET PSJXD=0
FOR
SET PSJXD=$ORDER(^PS(55,"AIV",PSJXD))
if 'PSJXD
QUIT
Begin DoDot:1
+47 SET PSJPDFN=0
+48 FOR
SET PSJPDFN=$ORDER(^PS(55,"AIV",PSJXD,PSJPDFN))
if 'PSJPDFN
QUIT
Begin DoDot:2
+49 SET PSJORD=0
+50 SET PSJORD=$ORDER(^PS(55,"AIV",PSJXD,PSJPDFN,PSJORD))
if 'PSJORD
QUIT
Begin DoDot:3
+51 KILL XREF
SET XREF="AIV"
DO CHKREF(XREF)
End DoDot:3
End DoDot:2
End DoDot:1
+52 DO XCLEAN
+53 QUIT
+54 ;
CHKREF(REF) ;Check cross references
+1 ; UD cross refs
+2 NEW PSJST,DATES
+3 IF REF["AU"
Begin DoDot:1
+4 SET PSJND0=$GET(^PS(55,PSJPDFN,5,PSJORD,0))
SET PSJST=$PIECE(PSJND0,"^",7)
+5 SET PSJND2=$GET(^PS(55,PSJPDFN,5,PSJORD,2))
+6 SET START=$PIECE(PSJND2,"^",2)
SET STOP=$PIECE(PSJND2,"^",4)
+7 IF REF="AUDS"
Begin DoDot:2
+8 IF START
IF (START'=PSJXD)
Begin DoDot:3
+9 SET DATES=START_"^"_STOP_"^"_PSJXD_"^^"_PSJST
+10 SET ^XTMP("PSJ XREF",REF,PSJPDFN,PSJORD,PSJXD)=DATES
End DoDot:3
End DoDot:2
QUIT
+11 IF STOP
IF (STOP'=PSJXD)
SET DATES=START_"^"_STOP_"^^"_PSJXD_"^"_PSJST
Begin DoDot:2
+12 SET ^XTMP("PSJ XREF",REF,PSJPDFN,PSJORD,PSJXD)=DATES
End DoDot:2
End DoDot:1
QUIT
+13 ; IV cross refs
+14 if REF'["AI"
QUIT
+15 SET PSJND0=$GET(^PS(55,PSJPDFN,"IV",PSJORD,0))
+16 SET PSJND2=$GET(^PS(55,PSJPDFN,"IV",PSJORD,2))
+17 SET START=$PIECE(PSJND0,"^",2)
SET STOP=$PIECE(PSJND0,"^",3)
SET PSJST=$PIECE(PSJND0,"^",4)
+18 IF REF="AIVS"
Begin DoDot:1
+19 IF START
IF (START'=PSJXD)
SET DATES=START_"^"_STOP_"^"_PSJXD_"^^"_PSJST
Begin DoDot:2
+20 SET ^XTMP("PSJ XREF",REF,PSJPDFN,PSJORD,PSJXD)=DATES
End DoDot:2
End DoDot:1
QUIT
+21 IF STOP
IF (STOP'=PSJXD)
SET DATES=START_"^"_STOP_"^^"_PSJXD_"^"_PSJST
Begin DoDot:1
+22 SET ^XTMP("PSJ XREF",REF,PSJPDFN,PSJORD,PSJXD)=DATES
End DoDot:1
+23 QUIT
+24 ;
XCLEAN ;
+1 NEW PSJPDFN,PSJORD,PSJSTP,PSJSTRT,OPSJSTRT,OPSJSTP,DATES
+2 SET REF=""
FOR
SET REF=$ORDER(^XTMP("PSJ XREF",REF))
if REF=""
QUIT
Begin DoDot:1
+3 SET PSJPDFN=0
+4 FOR
SET PSJPDFN=$ORDER(^XTMP("PSJ XREF",REF,PSJPDFN))
if 'PSJPDFN
QUIT
Begin DoDot:2
+5 SET PSJORD=0
+6 FOR
SET PSJORD=$ORDER(^XTMP("PSJ XREF",REF,PSJPDFN,PSJORD))
if 'PSJORD
QUIT
Begin DoDot:3
+7 SET PSJXD=0
+8 FOR
SET PSJXD=$ORDER(^XTMP("PSJ XREF",REF,PSJPDFN,PSJORD,PSJXD))
if 'PSJXD
QUIT
Begin DoDot:4
+9 SET DATES=^(PSJXD)
SET PSJSTRT=$PIECE(DATES,"^")
SET PSJSTP=$PIECE(DATES,"^",2)
+10 SET OPSJSTRT=$PIECE(DATES,"^",3)
SET OPSJSTP=$PIECE(DATES,"^",4)
+11 SET PSJST=$PIECE(DATES,"^",5)
+12 DO @REF
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
UDSTART ; UD Start Date/Time Xrefs ("AUDS")
+1 if 'PSJSTRT!($LENGTH(PSJSTRT)<5)
QUIT
+2 SET $PIECE(^PS(55,PSJPDFN,5,PSJORD,2),"^",2)=+PSJSTRT
AUDS ;
+1 SET ^PS(55,"AUDS",+PSJSTRT,PSJPDFN,PSJORD)=""
+2 if '$GET(OPSJSTRT)
QUIT
+3 KILL ^PS(55,"AUDS",OPSJSTRT,PSJPDFN,PSJORD)
+4 QUIT
UDSTOP ; UD Stop Date/Time Xrefs ("AU","AUS","AUD")
+1 if 'PSJSTP!($LENGTH(PSJSTP)<5)
QUIT
+2 SET $PIECE(^PS(55,PSJPDFN,5,PSJORD,2),"^",4)=+PSJSTP
AU ;
AUS ;
AUD IF PSJST?1.2U
SET ^PS(55,PSJPDFN,5,"AU",PSJST,+PSJSTP,PSJORD)=""
+1 SET ^PS(55,PSJPDFN,5,"AUS",+PSJSTP,PSJORD)=""
+2 SET ^PS(55,"AUD",+PSJSTP,PSJPDFN,PSJORD)=""
+3 if $GET(OPSJSTP)=""
QUIT
+4 IF PSJST?1.2U
KILL ^PS(55,PSJPDFN,5,"AU",PSJST,OPSJSTP,PSJORD)
+5 KILL ^PS(55,PSJPDFN,5,"AUS",OPSJSTP,PSJORD)
+6 KILL ^PS(55,"AUD",OPSJSTP,PSJPDFN,PSJORD)
UDNVDT ;
+1 if $GET(PSJNVDT)]""
SET $PIECE(^PS(55,PSJPDFN,5,PSJORD,4),"^",2)=+$GET(PSJNVDT)
+2 QUIT
IVSTART ; IV Start Date/Time Xrefs ("AIVS")
+1 if 'PSJSTRT!($LENGTH(PSJSTP)<5)
QUIT
+2 SET $PIECE(^PS(55,PSJPDFN,"IV",PSJORD,0),"^",2)=+PSJSTRT
AIVS ;
+1 SET ^PS(55,"AIVS",+PSJSTRT,PSJPDFN,PSJORD)=""
+2 if $GET(OPSJSTRT)=""
QUIT
+3 KILL ^PS(55,"AIVS",OPSJSTRT,PSJPDFN,PSJORD)
+4 QUIT
IVSTOP ; IV Stop Date/Time Xrefs ("AIS","AIT","AIV")
+1 if 'PSJSTP!($LENGTH(PSJSTP)<5)
QUIT
+2 SET $PIECE(^PS(55,PSJPDFN,"IV",PSJORD,0),"^",3)=+PSJSTP
AIT ;
AIS ;
AIV IF PSJST?1.2U
SET ^PS(55,PSJPDFN,"IV","AIT",PSJST,+PSJSTP,PSJORD)=""
+1 SET ^PS(55,PSJPDFN,"IV","AIS",+PSJSTP,PSJORD)=""
+2 SET ^PS(55,"AIV",+PSJSTP,PSJPDFN,PSJORD)=""
+3 IF PSJST?1.2U
SET ^PS(55,PSJPDFN,"IV","AIT",PSJST,+PSJSTP,PSJORD)=""
+4 if $GET(OPSJSTP)=""
QUIT
+5 IF PSJST?1.2U
KILL ^PS(55,PSJPDFN,"IV","AIT",PSJST,OPSJSTP,PSJORD)
+6 KILL ^PS(55,PSJPDFN,"IV","AIS",OPSJSTP,PSJORD)
+7 KILL ^PS(55,"AIV",OPSJSTP,PSJPDFN,PSJORD)
IVNVDT ;
+1 if $GET(PSJNVDT)]""
SET $PIECE(^PS(55,PSJPDFN,"IV",PSJORD,4),"^",2)=+$GET(PSJNVDT)
+2 QUIT
