| 1 | IBQLPL ;LEB/MRY - PATIENTS QUALIFY/MISSING INFO LIST ; 22-MAR-95
|
|---|
| 2 | ;;1.0;UTILIZATION MGMT ROLLUP LOCAL;**1**;Oct 01, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | I '$D(DT) D DT^DICRW
|
|---|
| 6 | D PULL
|
|---|
| 7 | W !! W:IBRPT="Q" "List Patients to be included in Rollup" W:IBRPT="M" "List Patients with Missing Data"
|
|---|
| 8 | ;W !,"The next National Rollup will be " S Y=IBBDT X ^DD("DD") W Y_" to " S Y=IBEDT X ^DD("DD") W Y
|
|---|
| 9 | I IBMSG'="" W !!,IBMSG,!,IBMSG1
|
|---|
| 10 | ;
|
|---|
| 11 | ; -- get date range
|
|---|
| 12 | W ! D DATE^IBOUTL
|
|---|
| 13 | I IBBDT=""!(IBEDT="") G END
|
|---|
| 14 | ;
|
|---|
| 15 | DEV ; -- select device, run option
|
|---|
| 16 | W ! S %ZIS="QM" D ^%ZIS G:POP END
|
|---|
| 17 | I $D(IO("Q")) F I="IBBDT","IBEDT","IBRPT" S ZTSAVE(I)=""
|
|---|
| 18 | I $D(IO("Q")) S ZTRTN="RPT^IBQLPL",ZTDESC="UM - ROLLUP LIST" D ^%ZTLOAD K IO("Q"),ZTSK D HOME^%ZIS G END
|
|---|
| 19 | U IO
|
|---|
| 20 | ;
|
|---|
| 21 | RPT ; -- entry point from taskman
|
|---|
| 22 | ; store data in ^tmp($j)
|
|---|
| 23 | K ^TMP("IBQLPL",$J),IB
|
|---|
| 24 | S IBPAG=0,IBQUIT=0
|
|---|
| 25 | I IBRPT="M" D REQFLDS
|
|---|
| 26 | D START^IBQLPL1
|
|---|
| 27 | I $G(ZTSTOP) G END
|
|---|
| 28 | ;
|
|---|
| 29 | D PRINT^IBQLPL2
|
|---|
| 30 | ;
|
|---|
| 31 | END ; -- Clean up
|
|---|
| 32 | W ! K ^TMP("IBQLPL",$J),I,X,DFN,SSN,DGPM,VAIN,VAINDT,IB,IBD,IBBDT,IBEDT,IBQUIT,IBPAG,IBRPT,IBTRN,IBTRN1,IBNAM,IBFLD,IBTY,IBHR,IBDAY,IBERR,IBDAY,IBORDER,IB001,IBENRLL,ENRLL
|
|---|
| 33 | I $D(ZTQUEUED) S ZTREQ="@" Q
|
|---|
| 34 | D ^%ZISC
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | PULL ;PULL DATES
|
|---|
| 38 | S IBPDT1=$E(DT,1,3)-1_"1001"_"-"_$E(DT,1,3)_"0331",IBRDT1=$E(DT,1,3)_"0515"
|
|---|
| 39 | S IBPDT2=$E(DT,1,3)_"1001"_"-"_($E(DT,1,3)+1)_"0331",IBRDT2=$E(DT,1,3)+1_"0515"
|
|---|
| 40 | S IBPDT3=$E(DT,1,3)_"0401"_"-"_$E(DT,1,3)_"0930",IBRDT3=$E(DT,1,3)_"1115"
|
|---|
| 41 | S IBRDT=$S(DT'>IBRDT1:IBRDT1,DT>IBRDT3:IBRDT2,1:IBRDT3)
|
|---|
| 42 | S IBPDT=$S(DT'>IBRDT1:IBPDT1,DT>IBRDT3:IBPDT2,1:IBPDT3)
|
|---|
| 43 | S IBBDT=$P(IBPDT,"-"),IBEDT=$P(IBPDT,"-",2)
|
|---|
| 44 | S IBMSG=">> Next rollup transmission deadline: " S Y=IBRDT X ^DD("DD") S IBMSG=IBMSG_Y,IBMSG1=">> Covering periods: " S Y=IBBDT X ^DD("DD") S IBMSG1=IBMSG1_Y_" to " S Y=IBEDT X ^DD("DD") S IBMSG1=IBMSG1_Y
|
|---|
| 45 | K IBPDT1,IBPDT2,IBPDT3,IBPDT,IBRDT,IBRDT2,IBRDT3,Y Q
|
|---|
| 46 | ;
|
|---|
| 47 | REQFLDS ; -- set ibd(fld#) for missing message explanation
|
|---|
| 48 | F I=3:1 S X=$T(REQFLDS+I) Q:$P(X,";",3)="Q" S IBD($P(X,";",3))=$P(X,";",4)
|
|---|
| 49 | Q
|
|---|
| 50 | ;;.01;ENTRY ID;
|
|---|
| 51 | ;;.02;SITE;
|
|---|
| 52 | ;;.03;SSN;
|
|---|
| 53 | ;;.04;ADMITTING DIAGNOSIS;
|
|---|
| 54 | ;;.05;ENROLLMENT CODES;
|
|---|
| 55 | ;;.06;ADMITTING PHYSICIAN CODE;
|
|---|
| 56 | ;;.07;ATTENDING CODE;
|
|---|
| 57 | ;;.08;RESIDENT CODE;
|
|---|
| 58 | ;;.09;ACUTE CARE ADMISSION DATE (PATIENT MOVEMENT);
|
|---|
| 59 | ;;.1;ACUTE CARE DISCHARGE DATE;
|
|---|
| 60 | ;;.11;WARD;
|
|---|
| 61 | ;;.12;TREATING SPECIALTY;
|
|---|
| 62 | ;;.13;ACUTE ADMISSION(Y/N);
|
|---|
| 63 | ;;1.01;SEVERITY OF ILLNESS FROM ADMISSION;
|
|---|
| 64 | ;;1.02;INTENSITY OF SERVICE FROM ADMISSION;
|
|---|
| 65 | ;;1.03;REASON FOR NON-ACUTE ADMISSION;
|
|---|
| 66 | ;;1.04;PROVIDER INTERVIEWED(Y/N);
|
|---|
| 67 | ;;1.05;ADMISSION INFLUENCED(Y/N);
|
|---|
| 68 | ;;1.06;LOCAL, NATIONAL, OR BOTH;
|
|---|
| 69 | ;;1.07;SERVICE FROM ADMISSION REVIEW;
|
|---|
| 70 | ;;13.01;DAY OF CONTINUED STAY;
|
|---|
| 71 | ;;13.02;INTENSITY OF SERVICE FROM CONTINUED STAY;
|
|---|
| 72 | ;;13.03;SEVERITY OF ILLNESS FROM CONTINUED STAY;
|
|---|
| 73 | ;;13.04;D/C FROM CONTINUED STAY;
|
|---|
| 74 | ;;13.05;INTERVIEWED(Y/N);
|
|---|
| 75 | ;;13.06;REASONS FROM CONTINUED STAY;
|
|---|
| 76 | ;;13.07;TREATING SPECIALTY FROM CONTINUED STAY;
|
|---|
| 77 | ;;13.08;SERVICE FROM CONTINUED STAY;
|
|---|
| 78 | ;;Q;QUIT
|
|---|
