IMRSCH ;ISC-SF/JLI,HCIOFO/FT-OUTPATIENT ACTIVITY ;01/14/02 11:10 ;
 ;;2.1;IMMUNOLOGY CASE REGISTRY;**16,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^IMRDAT
 .S IMRSEND=1
 .Q
 G EXIT
 Q
OP2 ; SET ^TMP FOR SEPERATE 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^IMRSCH(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