101 lines
4.7 KiB
Mathematica
101 lines
4.7 KiB
Mathematica
IMRSUDOP ;ISC-SF/JLI,HCIOFO/FT/FAI/SPS-LOCAL COUNT OF PTS, STATUS, OP VISITS, IP STAYS, ETC. ;07/23/01 07:28
|
|
;;2.1;IMMUNOLOGY CASE REGISTRY;**5,13**;Feb 09, 1998
|
|
DQ ;
|
|
U IO K ^TMP($J) S X1=IMRED,X2=1 D C^%DTC S IMREDP1=X
|
|
F IMRL=0:0 S IMRL=$O(^IMR(158,IMRL)) Q:IMRL'>0 S X=+^(IMRL,0),IMR1C=+$P(^(0),U,42) D XOR^IMRXOR S IMRDFN=X I $D(^DPT(IMRDFN,0)) S DFN=IMRDFN D NS^IMRCALL K DFN F IMR0C=IMR1C,"T" I IMR2C!(IMR0C="T") S IMR1C="C"_IMR0C D C1
|
|
K VADM,VA
|
|
D ^IMRLCNT1,^IMRLCNT2
|
|
KILL Q
|
|
Q
|
|
C1 S IMRSDV=0,IMRSDVA=1,DFN=IMRDFN D DEM^VADPT
|
|
S IMRDTH=$P($G(VADM(6)),"^",1)
|
|
I IMRDTH,IMRDTH<IMRSD Q ;quit if dead before start date of report
|
|
I +$$VERSION^XPDUTL("SD")>5.3 S IMRSDV=1 D ACRP G DGPT ;get data from File 409.68
|
|
I +$$PATCH^XPDUTL("SD*5.3*131")>0 S IMRSDV=1 D ACRP G DGPT ;get data from File 409.68
|
|
S VASD("F")=IMRSD,VASD("T")=IMRED D SDA^VADPT K DFN,VASD
|
|
F IMRDY=0:0 S IMRDY=$O(^UTILITY("VASD",$J,IMRDY)) Q:IMRDY'>0 S IMRD=+^(IMRDY,"I"),IMRCS=$P(^("I"),U,2) D C2
|
|
K ^UTILITY("VASD",$J)
|
|
S IMRSDV=1
|
|
F IMRD=IMRSD-.0000001:0 S IMRD=$O(^SDV("C",IMRDFN,IMRD)) Q:IMRD'>0!(IMRD'<(IMRED+1)) S IMRSDVA=$S('$D(^TMP($J,IMR1C,"PAT",IMRDFN,"S",(IMRD\1))):1,1:0) S IMRSDVI=IMRD D SDVCS^IMRUTL I $D(IMRAR(409.51)) D
|
|
.S J="" F S J=$O(IMRAR(409.51,J)) Q:J="" S IMRCS=$G(IMRAR(409.51,J,.01,"I")) D C2
|
|
.Q
|
|
DGPT K IMRAR,IMRSDVI
|
|
F IMRI=0:0 S IMRI=$O(^DGPT("B",IMRDFN,IMRI)) Q:IMRI'>0 I $D(^DGPT(IMRI,0)),+^(0)=IMRDFN S IMRPTF=IMRI D PTF^IMRUTL D
|
|
.S IMRDD=$S(+IMRDD'>0:0,1:+IMRDD)
|
|
.Q:'IMRAD
|
|
.S IMRFLG=0
|
|
.I 'IMRDD D DBCHK(IMRDFN,IMRAD,.IMRDD,.IMRFLG)
|
|
.Q:IMRFLG
|
|
.I (IMRDD=0&(IMRAD'>IMRED))!((IMRDD'<IMRSD)&(IMRAD'>IMRED)) D C3
|
|
.Q
|
|
Q
|
|
C2 ;
|
|
S:'IMRSDV IMRCS=+$$ARSC^IMRUTL(+IMRCS) ;get ptr value to File 40.7
|
|
S IMRCS=$S($D(^DIC(40.7,IMRCS,0)):$P(^(0),U,2),1:"NO SC ID")
|
|
S:IMRCS="" IMRCS=$P(^DIC(40.7,IMRCS,0),U)
|
|
I IMRCS="NO SC ID" S ^TMP($J,IMR1C,"NO SC",IMRDFN,IMRD,IMRSDV)=""
|
|
S ^("OP")=$S($D(^TMP($J,IMR1C,"PAT",IMRDFN,"OP")):^("OP"),1:0)+1,^(IMRCS)=$S($D(^("OP",IMRCS)):^(IMRCS),1:0)+1
|
|
S IMRDX=IMRD\1
|
|
I '$D(^TMP($J,IMR1C,"PAT",IMRDFN,"S",IMRDX,IMRCS)) S ^(IMRCS)=$S(IMRSDV:"SDV",1:""),^(IMRDX)=$S(($D(^TMP($J,IMR1C,"PAT",IMRDFN,"S",IMRDX))#2):^(IMRDX),1:0)+1
|
|
Q
|
|
C3 ;
|
|
I '$D(IMRSUF)!('$D(IMREC)) S IMRPTF=IMRI D PTF^IMRUTL
|
|
I IMRSUF'="",'(IMRSUF="9AA"!(IMRSUF="A0")!(IMRSUF="9AB")!(IMRSUF="9AD")!(IMRSUF="9AC")!(IMRSUF="9AE")!(IMRSUF="9BB")!(IMRSUF="A4")!(IMRSUF="A5")!(IMRSUF="BU")!(IMRSUF="BV")!(IMRSUF="PA")) Q
|
|
Q:+IMREC>1 ; IGNORE CENSUS PTF ENTRIES
|
|
S IMRAD1=IMRAD,IMRAD=$S(IMRAD'<IMRSD:IMRAD,1:IMRSD),IMRDD=$S(IMRDD=0:IMREDP1,(IMRDD\1)'>IMRED:IMRDD,1:IMREDP1)
|
|
S ^("IP")=$S($D(^TMP($J,IMR1C,"PAT",IMRDFN,"IP")):^("IP"),1:0)+1,X1=IMRDD\1,X2=IMRAD\1
|
|
D ^%DTC S:X=0 X=1 S IMRDAYS=X,^("DAYS")=$S($D(^TMP($J,IMR1C,"PAT",IMRDFN,"IP","DAYS")):^("DAYS"),1:0)+IMRDAYS,^(IMRDAYS)=$S($D(^(IMRDAYS)):^(IMRDAYS),1:0)+1
|
|
S IMRD1=IMRAD\1,K=0 S IMRAD1=IMRAD1\1
|
|
S IMRPTF=IMRI D ICDM^IMRUTL,REORDER^IMRUTL K IMRAR
|
|
I $D(IMR4502) F K=IMRAD1:0 S K=$O(IMR4502(K)) Q:K'<IMRAD!(K="") S IMRAD1=K\1
|
|
S K=0,IMRROU="C4^IMRLCNT1"
|
|
F IMRJ=IMRD1:0 S IMRJ=$O(IMR4502(IMRJ)) Q:IMRJ'>0!(IMRJ'<(IMRDD\1)) D
|
|
.D C31,^%DTC S IMRDAYS=X
|
|
.S IMRBS=$P(IMR4502(IMRJ),U,1) ;treating specialty (external) File 45
|
|
.S IMRBSO=$$TREAT(IMRDFN) ;treating specialty (external) File 2
|
|
.S IMRBS=$S(IMRBS]"":IMRBS,1:IMRBSO)
|
|
.S:IMRBS="" IMRBS="NO ID"
|
|
.D @IMRROU S IMRD1=IMRJ\1
|
|
.Q
|
|
K IMRROU S X2=IMRD1,X1=IMRDD\1 D ^%DTC S:X=0 X=1 S IMRDAYS=X,IMRBS=$S($D(IMRFIRST):$P(IMRFIRST,U,1),1:0) D
|
|
.S IMRBSO=$$TREAT(IMRDFN)
|
|
.S IMRBS=$S(IMRBS]"":IMRBS,1:IMRBSO)
|
|
.S:IMRBS="" IMRBS="NO ID"
|
|
.D C4^IMRLCNT1
|
|
.Q
|
|
K IMR4502,IMRFIRST
|
|
Q
|
|
C31 S X1=IMRJ\1,X2=IMRD1
|
|
Q
|
|
DBCHK(DFN,IMRAD,IMRDD,IMRFLG) ; Double Check if Admission date is valid and
|
|
; if there is a discharge date or not. If
|
|
; Admission date is not valid set IMRFLG=1
|
|
; if Discharge date exist pass it back.
|
|
N IMRX
|
|
S VAINDT=IMRAD D ADM^VADPT2 K VAINDT I 'VADMVT K VADMVT S IMRFLG=1 Q
|
|
S IMRX=$$GET1^DIQ(405,VADMVT,.17,"I") K VADMVT Q:'IMRX
|
|
S IMRDD=$$GET1^DIQ(405,IMRX,.01,"I")
|
|
Q
|
|
TREAT(DFN) ; Retrieve the patient's Treatment Specialty
|
|
S Y=$$GET1^DIQ(2,DFN,.103,"")
|
|
Q Y
|
|
ACRP ; Ambulatory Care Reporting Changes
|
|
; If site has SD*5.3*131 installed, then use the ACRP APIs to get
|
|
; the stop code data.
|
|
N QUERY
|
|
D OPEN^SDQ(.QUERY)
|
|
D INDEX^SDQ(.QUERY,"PATIENT/DATE","SET")
|
|
D PAT^SDQ(.QUERY,IMRDFN,"SET")
|
|
D DATE^SDQ(.QUERY,IMRSD,IMREDP1,"SET")
|
|
D SCANCB^SDQ(.QUERY,"D SCAN^IMRLCNT(Y,Y0)","SET")
|
|
D ACTIVE^SDQ(.QUERY,"TRUE","SET")
|
|
D SCAN^SDQ(.QUERY,"FORWARD")
|
|
D CLOSE^SDQ(.QUERY)
|
|
Q
|
|
SCAN(Y,Y0) ; Scan records returned by ACRP API
|
|
; data comes from the Outpatient Encounter file (409.68)
|
|
S IMRD=+Y0 ;get visit/admit date/time
|
|
S IMRCS=$P(Y0,U,3) ;dds id, pointer to File 40.7 (Clinic Stop)
|
|
D C2
|
|
Q
|