source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRSCH.m@ 1639

Last change on this file since 1639 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1IMRSCH ;ISC-SF/JLI,HCIOFO/FT-OUTPATIENT ACTIVITY ;01/14/02 11:10 ;
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;**16,15**;Feb 09, 1998
3 ;
4OP ; Get Scheduling Visits (File 409.5). Called from IMRDAT1
5 K ^TMP($J,"IMROP") S IMROP=0
6 S IMRS=$E(IMRSD,1,5)_"00" ;beginning of start date year and month (e.g., 2971000)
7 D ACRP G OP0 ;look in File 409.68
8 Q
9OP0 K IMRAR,IMROPI
10 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
11 . S IMRCNT2=0 F S IMRCNT2=$O(^TMP($J,"IMROP",IMRIX,IMRSJ,IMRCNT2)) Q:IMRCNT2'>0 D
12 .. S IMRDESIG=$P(^TMP($J,"IMROP",IMRIX,IMRSJ,IMRCNT2),U)
13 .. S IMRC=IMRC+1,^TMP($J,"IMRX",IMRC)="OP"_"^"_IMRDESIG_"^"_IMRIX_"^"_IMRSJ_"^"_$P(^TMP($J,"IMROP",IMRIX,IMRSJ,IMRCNT2),U,2) D LCHK^IMRDAT
14 .S IMRSEND=1
15 .Q
16 G EXIT
17 Q
18OP2 ; SET ^TMP FOR SEPERATE ENCOUNTERS
19 ; IMRD=DATE/TIME OF ENCOUNTER, IMRSX=AMIS reporting stop code (internal)
20 ; IMROE=IEN OF FILE 409.68 OUTPATIENT ENCOUNTER
21 N DXLIST,I
22 D GETDX^SDOE(IMROE,"DXLIST")
23 S I=0,IMRCNT=0
24 F S I=$O(DXLIST(I)) Q:'I D
25 . S IMRDXL=$P(^ICD9($P(DXLIST(I),U),0),U)
26 . S IMRCNT=IMRCNT+1,^TMP($J,"IMROP",IMRD,IMRSX,IMRCNT)="ICD9"_"^"_IMRDXL
27 ;Now retrieve the CPT4 procedure codes
28 N CPTLIST,I,J
29 D GETCPT^SDOE(IMROE,"CPTLIST")
30 S I=0
31 F S I=$O(CPTLIST(I)) Q:'I D
32 . S IMRCNT=IMRCNT+1
33 . S IMRCPT=$P($G(^ICPT($P($G(CPTLIST(I)),U),0)),U)
34 . S ^TMP($J,"IMROP",IMRD,IMRSX,IMRCNT)="CPT4"_"^"_IMRCPT
35 Q
36ACRP ; Ambulatory Care Reporting Project changes
37 ; If site has SD*5.3*131 installed, then use the ACRP APIs to get
38 ; the stop code data.
39 N QUERY
40 D OPEN^SDQ(.QUERY)
41 D INDEX^SDQ(.QUERY,"PATIENT/DATE","SET")
42 D PAT^SDQ(.QUERY,IMRDFN,"SET")
43 D DATE^SDQ(.QUERY,IMRSD,IMRED,"SET")
44 D SCANCB^SDQ(.QUERY,"D SCAN^IMRSCH(Y,Y0)","SET")
45 D ACTIVE^SDQ(.QUERY,"TRUE","SET")
46 D SCAN^SDQ(.QUERY,"FORWARD")
47 D CLOSE^SDQ(.QUERY)
48 Q
49SCAN(Y,Y0) ; Scan records returned by ACRP API
50 ; data comes from the Outpatient Encounter file (409.68)
51 S IMRD=+Y0,IMRSX=$P(Y0,U,3),IMROE=Y
52 S:IMRD>IMROP IMROP=IMRD ;visit/admit date/time
53 S IMRMO=+$E(IMRD,4,5),IMRYR=$E(IMRD,1,3)_"0000"
54 S IMRSX=$P($G(^DIC(40.7,+IMRSX,0)),U,2) ;amis reporting stop code
55 I IMRSX'="" D OP2
56 Q
57EXIT 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")
58 Q
Note: See TracBrowser for help on using the repository browser.