Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSJ078B

PSJ078B.m

Go to the documentation of this file.
  1. PSJ078B ;BIR/JLC - Check for stop date problems ;08-MAY-02 / 10:34 AM
  1. ;;5.0; INPATIENT MEDICATIONS ;**78**;16 DEC 97
  1. ;
  1. ;Reference to ^PS(55 is supported by DBIA# 2191.
  1. ;
  1. XREFS ;
  1. N PSJXD,PSJSTP
  1. S PSJXD=0 F S PSJXD=$O(^PS(55,"AUDS",PSJXD)) Q:'PSJXD D
  1. . S PSJPDFN=0
  1. . F S PSJPDFN=$O(^PS(55,"AUDS",PSJXD,PSJPDFN)) Q:'PSJPDFN D
  1. .. S PSJORD=0
  1. .. F S PSJORD=$O(^PS(55,"AUDS",PSJXD,PSJPDFN,PSJORD)) Q:'PSJORD D
  1. ... K XREF S XREF="AUDS" D CHKREF(XREF)
  1. S PSJPDFN=0 F S PSJPDFN=$O(^PS(55,PSJPDFN)) Q:'PSJPDFN D
  1. . S PSJXD=0
  1. . F S PSJXD=$O(^PS(55,PSJPDFN,5,"AUS",PSJXD)) Q:'PSJXD D
  1. .. S PSJORD=0
  1. .. F S PSJORD=$O(^PS(55,PSJPDFN,5,"AUS",PSJXD,PSJORD)) Q:'PSJORD D
  1. ... K XREF S XREF="AUS" D CHKREF(XREF)
  1. S PSJPDFN=0 F S PSJPDFN=$O(^PS(55,PSJPDFN)) Q:'PSJPDFN D
  1. . S PSJST="" F S PSJST=$O(^PS(55,PSJPDFN,5,"AU",PSJST)) Q:PSJST="" D
  1. .. S PSJXD=0
  1. .. F S PSJXD=$O(^PS(55,PSJPDFN,5,"AU",PSJST,PSJXD)) Q:'PSJXD D
  1. ... S PSJORD=0 F S PSJORD=$O(^PS(55,PSJPDFN,5,"AU",PSJST,PSJXD,PSJORD)) Q:'PSJORD D
  1. .... K XREF S XREF="AU" D CHKREF(XREF)
  1. S PSJXD=0 F S PSJXD=$O(^PS(55,"AUD",PSJXD)) Q:'PSJXD D
  1. . S PSJPDFN=0
  1. . S PSJPDFN=$O(^PS(55,"AUD",PSJXD,PSJPDFN)) Q:'PSJPDFN D
  1. .. S PSJORD=0
  1. .. F S PSJORD=$O(^PS(55,"AUD",PSJXD,PSJPDFN,PSJORD)) Q:'PSJORD D
  1. ... K XREF S XREF="AUD" D CHKREF(XREF)
  1. S PSJXD=0 F S PSJXD=$O(^PS(55,"AIVS",PSJXD)) Q:'PSJXD D
  1. . S PSJPDFN=0
  1. . F S PSJPDFN=$O(^PS(55,"AIVS",PSJXD,PSJPDFN)) Q:'PSJPDFN D
  1. .. S PSJORD=0
  1. .. F S PSJORD=$O(^PS(55,"AIVS",PSJXD,PSJPDFN,PSJORD)) Q:'PSJORD D
  1. ... K XREF S XREF="AIVS" D CHKREF(XREF)
  1. S PSJPDFN=0 F S PSJPDFN=$O(^PS(55,PSJPDFN)) Q:'PSJPDFN D
  1. . S PSJXD=0
  1. . F S PSJXD=$O(^PS(55,PSJPDFN,"IV","AIS",PSJXD)) Q:'PSJXD D
  1. .. S PSJORD=0
  1. .. F S PSJORD=$O(^PS(55,PSJPDFN,"IV","AIS",PSJXD,PSJORD)) Q:'PSJORD D
  1. ... K XREF S XREF="AIS" D CHKREF(XREF)
  1. S PSJPDFN=0 F S PSJPDFN=$O(^PS(55,PSJPDFN)) Q:'PSJPDFN D
  1. . S PSJST=""
  1. . F S PSJST=$O(^PS(55,PSJPDFN,"IV","AIT",PSJST)) Q:PSJST="" D
  1. .. S PSJXD=0
  1. .. F S PSJXD=$O(^PS(55,PSJPDFN,"IV","AIT",PSJST,PSJXD)) Q:'PSJXD D
  1. ... S PSJORD=0
  1. ... F S PSJORD=$O(^PS(55,PSJPDFN,"IV","AIT",PSJST,PSJXD,PSJORD)) Q:'PSJORD D
  1. .... K XREF S XREF="AIT" D CHKREF(XREF)
  1. S PSJXD=0 F S PSJXD=$O(^PS(55,"AIV",PSJXD)) Q:'PSJXD D
  1. . S PSJPDFN=0
  1. . F S PSJPDFN=$O(^PS(55,"AIV",PSJXD,PSJPDFN)) Q:'PSJPDFN D
  1. .. S PSJORD=0
  1. .. S PSJORD=$O(^PS(55,"AIV",PSJXD,PSJPDFN,PSJORD)) Q:'PSJORD D
  1. ... K XREF S XREF="AIV" D CHKREF(XREF)
  1. D XCLEAN
  1. Q
  1. ;
  1. CHKREF(REF) ;Check cross references
  1. ; UD cross refs
  1. N PSJST,DATES
  1. I REF["AU" D Q
  1. . S PSJND0=$G(^PS(55,PSJPDFN,5,PSJORD,0)),PSJST=$P(PSJND0,"^",7)
  1. . S PSJND2=$G(^PS(55,PSJPDFN,5,PSJORD,2))
  1. . S START=$P(PSJND2,"^",2),STOP=$P(PSJND2,"^",4)
  1. . I REF="AUDS" D Q
  1. .. I START,(START'=PSJXD) D
  1. ... S DATES=START_"^"_STOP_"^"_PSJXD_"^^"_PSJST
  1. ... S ^XTMP("PSJ XREF",REF,PSJPDFN,PSJORD,PSJXD)=DATES
  1. . I STOP,(STOP'=PSJXD) S DATES=START_"^"_STOP_"^^"_PSJXD_"^"_PSJST D
  1. .. S ^XTMP("PSJ XREF",REF,PSJPDFN,PSJORD,PSJXD)=DATES
  1. ; IV cross refs
  1. Q:REF'["AI"
  1. S PSJND0=$G(^PS(55,PSJPDFN,"IV",PSJORD,0))
  1. S PSJND2=$G(^PS(55,PSJPDFN,"IV",PSJORD,2))
  1. S START=$P(PSJND0,"^",2),STOP=$P(PSJND0,"^",3),PSJST=$P(PSJND0,"^",4)
  1. I REF="AIVS" D Q
  1. . I START,(START'=PSJXD) S DATES=START_"^"_STOP_"^"_PSJXD_"^^"_PSJST D
  1. .. S ^XTMP("PSJ XREF",REF,PSJPDFN,PSJORD,PSJXD)=DATES
  1. I STOP,(STOP'=PSJXD) S DATES=START_"^"_STOP_"^^"_PSJXD_"^"_PSJST D
  1. . S ^XTMP("PSJ XREF",REF,PSJPDFN,PSJORD,PSJXD)=DATES
  1. Q
  1. ;
  1. XCLEAN ;
  1. N PSJPDFN,PSJORD,PSJSTP,PSJSTRT,OPSJSTRT,OPSJSTP,DATES
  1. S REF="" F S REF=$O(^XTMP("PSJ XREF",REF)) Q:REF="" D
  1. . S PSJPDFN=0
  1. . F S PSJPDFN=$O(^XTMP("PSJ XREF",REF,PSJPDFN)) Q:'PSJPDFN D
  1. .. S PSJORD=0
  1. .. F S PSJORD=$O(^XTMP("PSJ XREF",REF,PSJPDFN,PSJORD)) Q:'PSJORD D
  1. ... S PSJXD=0
  1. ... F S PSJXD=$O(^XTMP("PSJ XREF",REF,PSJPDFN,PSJORD,PSJXD)) Q:'PSJXD D
  1. .... S DATES=^(PSJXD),PSJSTRT=$P(DATES,"^"),PSJSTP=$P(DATES,"^",2)
  1. .... S OPSJSTRT=$P(DATES,"^",3),OPSJSTP=$P(DATES,"^",4)
  1. .... S PSJST=$P(DATES,"^",5)
  1. .... D @REF
  1. Q
  1. ;
  1. UDSTART ; UD Start Date/Time Xrefs ("AUDS")
  1. Q:'PSJSTRT!($L(PSJSTRT)<5)
  1. S $P(^PS(55,PSJPDFN,5,PSJORD,2),"^",2)=+PSJSTRT
  1. AUDS ;
  1. S ^PS(55,"AUDS",+PSJSTRT,PSJPDFN,PSJORD)=""
  1. Q:'$G(OPSJSTRT)
  1. K ^PS(55,"AUDS",OPSJSTRT,PSJPDFN,PSJORD)
  1. Q
  1. UDSTOP ; UD Stop Date/Time Xrefs ("AU","AUS","AUD")
  1. Q:'PSJSTP!($L(PSJSTP)<5)
  1. S $P(^PS(55,PSJPDFN,5,PSJORD,2),"^",4)=+PSJSTP
  1. AU ;
  1. AUS ;
  1. AUD I PSJST?1.2U S ^PS(55,PSJPDFN,5,"AU",PSJST,+PSJSTP,PSJORD)=""
  1. S ^PS(55,PSJPDFN,5,"AUS",+PSJSTP,PSJORD)=""
  1. S ^PS(55,"AUD",+PSJSTP,PSJPDFN,PSJORD)=""
  1. Q:$G(OPSJSTP)=""
  1. I PSJST?1.2U K ^PS(55,PSJPDFN,5,"AU",PSJST,OPSJSTP,PSJORD)
  1. K ^PS(55,PSJPDFN,5,"AUS",OPSJSTP,PSJORD)
  1. K ^PS(55,"AUD",OPSJSTP,PSJPDFN,PSJORD)
  1. UDNVDT ;
  1. S:$G(PSJNVDT)]"" $P(^PS(55,PSJPDFN,5,PSJORD,4),"^",2)=+$G(PSJNVDT)
  1. Q
  1. IVSTART ; IV Start Date/Time Xrefs ("AIVS")
  1. Q:'PSJSTRT!($L(PSJSTP)<5)
  1. S $P(^PS(55,PSJPDFN,"IV",PSJORD,0),"^",2)=+PSJSTRT
  1. AIVS ;
  1. S ^PS(55,"AIVS",+PSJSTRT,PSJPDFN,PSJORD)=""
  1. Q:$G(OPSJSTRT)=""
  1. K ^PS(55,"AIVS",OPSJSTRT,PSJPDFN,PSJORD)
  1. Q
  1. IVSTOP ; IV Stop Date/Time Xrefs ("AIS","AIT","AIV")
  1. Q:'PSJSTP!($L(PSJSTP)<5)
  1. S $P(^PS(55,PSJPDFN,"IV",PSJORD,0),"^",3)=+PSJSTP
  1. AIT ;
  1. AIS ;
  1. AIV I PSJST?1.2U S ^PS(55,PSJPDFN,"IV","AIT",PSJST,+PSJSTP,PSJORD)=""
  1. S ^PS(55,PSJPDFN,"IV","AIS",+PSJSTP,PSJORD)=""
  1. S ^PS(55,"AIV",+PSJSTP,PSJPDFN,PSJORD)=""
  1. I PSJST?1.2U S ^PS(55,PSJPDFN,"IV","AIT",PSJST,+PSJSTP,PSJORD)=""
  1. Q:$G(OPSJSTP)=""
  1. I PSJST?1.2U K ^PS(55,PSJPDFN,"IV","AIT",PSJST,OPSJSTP,PSJORD)
  1. K ^PS(55,PSJPDFN,"IV","AIS",OPSJSTP,PSJORD)
  1. K ^PS(55,"AIV",OPSJSTP,PSJPDFN,PSJORD)
  1. IVNVDT ;
  1. S:$G(PSJNVDT)]"" $P(^PS(55,PSJPDFN,"IV",PSJORD,4),"^",2)=+$G(PSJNVDT)
  1. Q