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