| 1 | IMRSCH ;ISC-SF/JLI,HCIOFO/FT-OUTPATIENT ACTIVITY ;01/14/02 11:10 ;
|
|---|
| 2 | ;;2.1;IMMUNOLOGY CASE REGISTRY;**16,15**;Feb 09, 1998
|
|---|
| 3 | ;
|
|---|
| 4 | OP ; 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
|
|---|
| 9 | OP0 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
|
|---|
| 18 | OP2 ; 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
|
|---|
| 36 | ACRP ; 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
|
|---|
| 49 | SCAN(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
|
|---|
| 57 | 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")
|
|---|
| 58 | Q
|
|---|
