59 lines
2.3 KiB
Mathematica
59 lines
2.3 KiB
Mathematica
IMRODSCH ;ISC-SF/JLI,HCIOFO/FT-OUTPATIENT ACTIVITY ;03/09/02 11:10 ;
|
|
;;2.1;IMMUNOLOGY CASE REGISTRY;**15**;Feb 09, 1998
|
|
;
|
|
OP ; Get Scheduling Visits (File 409.5). Called from IMRDAT1
|
|
K ^TMP($J,"IMROP") S IMROP=0
|
|
S IMRS=$E(IMRSD,1,5)_"00" ;beginning of start date year and month (e.g., 2971000)
|
|
D ACRP G OP0 ;look in File 409.68
|
|
Q
|
|
OP0 K IMRAR,IMROPI
|
|
F IMRIX=0:0 S IMRIX=$O(^TMP($J,"IMROP",IMRIX)) Q:IMRIX'>0 F IMRSJ=0:0 S IMRSJ=$O(^TMP($J,"IMROP",IMRIX,IMRSJ)) Q:IMRSJ'>0 D
|
|
. S IMRCNT2=0 F S IMRCNT2=$O(^TMP($J,"IMROP",IMRIX,IMRSJ,IMRCNT2)) Q:IMRCNT2'>0 D
|
|
.. S IMRDESIG=$P(^TMP($J,"IMROP",IMRIX,IMRSJ,IMRCNT2),U)
|
|
.. S IMRC=IMRC+1,^TMP($J,"IMRX",IMRC)="OP"_"^"_IMRDESIG_"^"_IMRIX_"^"_IMRSJ_"^"_$P(^TMP($J,"IMROP",IMRIX,IMRSJ,IMRCNT2),U,2) D LCHK^IMRODATA
|
|
.S IMRSEND=1
|
|
.Q
|
|
G EXIT
|
|
Q
|
|
OP2 ; SET ^TMP FOR SEPARATE ENCOUNTERS
|
|
; IMRD=DATE/TIME OF ENCOUNTER, IMRSX=AMIS reporting stop code (internal)
|
|
; IMROE=IEN OF FILE 409.68 OUTPATIENT ENCOUNTER
|
|
N DXLIST,I
|
|
D GETDX^SDOE(IMROE,"DXLIST")
|
|
S I=0,IMRCNT=0
|
|
F S I=$O(DXLIST(I)) Q:'I D
|
|
. S IMRDXL=$P(^ICD9($P(DXLIST(I),U),0),U)
|
|
. S IMRCNT=IMRCNT+1,^TMP($J,"IMROP",IMRD,IMRSX,IMRCNT)="ICD9"_"^"_IMRDXL
|
|
;Now retrieve the CPT4 procedure codes
|
|
N CPTLIST,I,J
|
|
D GETCPT^SDOE(IMROE,"CPTLIST")
|
|
S I=0
|
|
F S I=$O(CPTLIST(I)) Q:'I D
|
|
. S IMRCNT=IMRCNT+1
|
|
. S IMRCPT=$P($G(^ICPT($P($G(CPTLIST(I)),U),0)),U)
|
|
. S ^TMP($J,"IMROP",IMRD,IMRSX,IMRCNT)="CPT4"_"^"_IMRCPT
|
|
Q
|
|
ACRP ; Ambulatory Care Reporting Project 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,IMRED,"SET")
|
|
D SCANCB^SDQ(.QUERY,"D SCAN^IMRODSCH(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,IMRSX=$P(Y0,U,3),IMROE=Y
|
|
S:IMRD>IMROP IMROP=IMRD ;visit/admit date/time
|
|
S IMRMO=+$E(IMRD,4,5),IMRYR=$E(IMRD,1,3)_"0000"
|
|
S IMRSX=$P($G(^DIC(40.7,+IMRSX,0)),U,2) ;amis reporting stop code
|
|
I IMRSX'="" D OP2
|
|
Q
|
|
EXIT K IMRCNT,IMRCNT2,IMRCPT,IMRDESIG,IMRDXL,IMRIX,IMRD,IMRS,IMRSX,IMRSY,IMRD2,IMRSJ,IMRSC,IMRSC1,IMRSI,IMRSK,IMRSL,IMRSM,IMRSN,IMRSR,IMRMO,IMRYR,^TMP($J,"IMRS"),^TMP($J,"IMRSC"),^TMP($J,"IMRSDV")
|
|
Q
|