Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBQLPL

IBQLPL.m

Go to the documentation of this file.
IBQLPL ;LEB/MRY - PATIENTS QUALIFY/MISSING INFO LIST ; 22-MAR-95
 ;;1.0;UTILIZATION MGMT ROLLUP LOCAL;**1**;Oct 01, 1995
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
 I '$D(DT) D DT^DICRW
 D PULL
 W !! W:IBRPT="Q" "List Patients to be included in Rollup" W:IBRPT="M" "List Patients with Missing Data"
 ;W !,"The next National Rollup will be " S Y=IBBDT X ^DD("DD") W Y_" to " S Y=IBEDT X ^DD("DD") W Y
 I IBMSG'="" W !!,IBMSG,!,IBMSG1
 ;
 ; -- get date range
 W ! D DATE^IBOUTL
 I IBBDT=""!(IBEDT="") G END
 ;
DEV ; -- select device, run option
 W ! S %ZIS="QM" D ^%ZIS G:POP END
 I $D(IO("Q")) F I="IBBDT","IBEDT","IBRPT" S ZTSAVE(I)=""
 I $D(IO("Q")) S ZTRTN="RPT^IBQLPL",ZTDESC="UM - ROLLUP LIST" D ^%ZTLOAD K IO("Q"),ZTSK D HOME^%ZIS G END
 U IO
 ;
RPT ; -- entry point from taskman
 ;   store data in ^tmp($j)
 K ^TMP("IBQLPL",$J),IB
 S IBPAG=0,IBQUIT=0
 I IBRPT="M" D REQFLDS
 D START^IBQLPL1
 I $G(ZTSTOP) G END
 ;
 D PRINT^IBQLPL2
 ;
END ; -- Clean up
 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
 I $D(ZTQUEUED) S ZTREQ="@" Q
 D ^%ZISC
 Q
 ;
PULL ;PULL DATES
 S IBPDT1=$E(DT,1,3)-1_"1001"_"-"_$E(DT,1,3)_"0331",IBRDT1=$E(DT,1,3)_"0515"
 S IBPDT2=$E(DT,1,3)_"1001"_"-"_($E(DT,1,3)+1)_"0331",IBRDT2=$E(DT,1,3)+1_"0515"
 S IBPDT3=$E(DT,1,3)_"0401"_"-"_$E(DT,1,3)_"0930",IBRDT3=$E(DT,1,3)_"1115"
 S IBRDT=$S(DT'>IBRDT1:IBRDT1,DT>IBRDT3:IBRDT2,1:IBRDT3)
 S IBPDT=$S(DT'>IBRDT1:IBPDT1,DT>IBRDT3:IBPDT2,1:IBPDT3)
 S IBBDT=$P(IBPDT,"-"),IBEDT=$P(IBPDT,"-",2)
 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
 K IBPDT1,IBPDT2,IBPDT3,IBPDT,IBRDT,IBRDT2,IBRDT3,Y Q
 ;
REQFLDS ; -- set ibd(fld#) for missing message explanation
 F I=3:1 S X=$T(REQFLDS+I) Q:$P(X,";",3)="Q"  S IBD($P(X,";",3))=$P(X,";",4)
 Q
 ;;.01;ENTRY ID;
 ;;.02;SITE;
 ;;.03;SSN;
 ;;.04;ADMITTING DIAGNOSIS;
 ;;.05;ENROLLMENT CODES;
 ;;.06;ADMITTING PHYSICIAN CODE;
 ;;.07;ATTENDING CODE;
 ;;.08;RESIDENT CODE;
 ;;.09;ACUTE CARE ADMISSION DATE (PATIENT MOVEMENT);
 ;;.1;ACUTE CARE DISCHARGE DATE;
 ;;.11;WARD;
 ;;.12;TREATING SPECIALTY;
 ;;.13;ACUTE ADMISSION(Y/N);
 ;;1.01;SEVERITY OF ILLNESS FROM ADMISSION;
 ;;1.02;INTENSITY OF SERVICE FROM ADMISSION;
 ;;1.03;REASON FOR NON-ACUTE ADMISSION;
 ;;1.04;PROVIDER INTERVIEWED(Y/N);
 ;;1.05;ADMISSION INFLUENCED(Y/N);
 ;;1.06;LOCAL, NATIONAL, OR BOTH;
 ;;1.07;SERVICE FROM ADMISSION REVIEW;
 ;;13.01;DAY OF CONTINUED STAY;
 ;;13.02;INTENSITY OF SERVICE FROM CONTINUED STAY;
 ;;13.03;SEVERITY OF ILLNESS FROM CONTINUED STAY;
 ;;13.04;D/C FROM CONTINUED STAY;
 ;;13.05;INTERVIEWED(Y/N);
 ;;13.06;REASONS FROM CONTINUED STAY;
 ;;13.07;TREATING SPECIALTY FROM CONTINUED STAY;
 ;;13.08;SERVICE FROM CONTINUED STAY;
 ;;Q;QUIT