| 1 | IBQLCHK ;LEB/MRY - UM ROLLUP - CHECK INFO. IN IB(array) ; 4-JUN-95
 | 
|---|
| 2 |  ;;1.0;UTILIZATION MGMT ROLLUP LOCAL;;Oct 01, 1995
 | 
|---|
| 3 |  ;;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
| 4 |  ;
 | 
|---|
| 5 |  ; Input:  IBTRN
 | 
|---|
| 6 |  ; Output: IB(array)
 | 
|---|
| 7 |  ;
 | 
|---|
| 8 |  I '$D(DT) D DT^DICRW
 | 
|---|
| 9 |  K IBDATA S IBQUIT=""
 | 
|---|
| 10 | CLAIMS ;
 | 
|---|
| 11 |  D CLAIMS^IBQL356 Q:IBQUIT
 | 
|---|
| 12 | ADM ;
 | 
|---|
| 13 |  S IBTRV=$O(^IBT(356.1,"C",IBTRN,""))
 | 
|---|
| 14 |  D ADMIT^IBQL356 Q:IBQUIT
 | 
|---|
| 15 |  S X="" F IBFLD=.01:.01:.13 S X=X_IBFLD_":"_IB(IBFLD)_"^"
 | 
|---|
| 16 |  S IBDATA(0)=$P(X,"^",1,$L(X,"^")-1)
 | 
|---|
| 17 |  S X="" F IBFLD=1.01:.01:1.07 S X=X_IBFLD_":"_IB(IBFLD)_"^"
 | 
|---|
| 18 |  S IBDATA(1)=$P(X,"^",1,$L(X,"^")-1)
 | 
|---|
| 19 | STAY ;
 | 
|---|
| 20 |  S IBPIS=IB(1.02)
 | 
|---|
| 21 |  F  S IBTRV=$O(^IBT(356.1,"C",IBTRN,IBTRV)) Q:'IBTRV  D  Q:IBQUIT
 | 
|---|
| 22 |  .D STAY^IBQL356 Q:IBQUIT
 | 
|---|
| 23 |  .S X="" F IBFLD=13.01,13.02,13.03,13.04,13.05,13.06,13.07,13.08 S X=X_(IBFLD-13)_":"_IB(IBFLD)_"^"
 | 
|---|
| 24 |  .S IBDATA(IB(13.01))=$P(X,"^",1,$L(X,"^")-1)
 | 
|---|
| 25 |  ;Q
 | 
|---|
| 26 |  ;
 | 
|---|
| 27 | PRINT ;
 | 
|---|
| 28 |  ;D HDR
 | 
|---|
| 29 |  W #,"CLAIMS TRACKING AND ADMISSION REVIEW DATA"
 | 
|---|
| 30 |  W ! F I=1:1:80 W "="
 | 
|---|
| 31 |  W !
 | 
|---|
| 32 |  W !!,"IB(.01) - ENTRY ID: ",?25,IB(.01)
 | 
|---|
| 33 |  W !,"IB(.02) - SITE: ",?25,IB(.02)
 | 
|---|
| 34 |  W !,"IB(.03) - SSN#: ",?25,IB(.03)
 | 
|---|
| 35 |  W !,"IB(.04) - ADM DIAGNOSIS: ",?25,IB(.04)
 | 
|---|
| 36 |  W !,"IB(.05) - ENROLL: ",?25,IB(.05)
 | 
|---|
| 37 |  W !,"IB(.06) - ADMITTING PHY: ",?25,IB(.06)
 | 
|---|
| 38 |  W !,"IB(.07) - ATTENDING PHY: ",?25,IB(.07)
 | 
|---|
| 39 |  W !,"IB(.08) - RESIDENT PHY: ",?25,IB(.08)
 | 
|---|
| 40 |  W !,"IB(.09) - ADMISSION: ",?25,IB(.09)
 | 
|---|
| 41 |  W !,"IB(.1) - DISCHARGE: ",?25,IB(.1)
 | 
|---|
| 42 |  W !,"IB(.11) - WARD: ",?25,IB(.11)
 | 
|---|
| 43 |  W !,"IB(.12) - TREATING SPECIALTY: ",?25,IB(.12)
 | 
|---|
| 44 |  W !,"IB(1.01) - SI FROM ADM: ",?25,IB(1.01)
 | 
|---|
| 45 |  W !,"IB(1.02) - IS FROM ADM: ",?25,IB(1.02)
 | 
|---|
| 46 |  W !,"IB(1.03) - REASONS FROM ADM: ",?25,IB(1.03)
 | 
|---|
| 47 |  W !,"IB(1.04) - PROVIDER INTERVIEWED?: ",?25,IB(1.04)
 | 
|---|
| 48 |  W !,"IB(1.05) - ADM INFLUENCED?: ",?25,IB(1.05)
 | 
|---|
| 49 |  W !,"IB(1.06) - ROLLUP TYPE: ",?25,IB(1.06)
 | 
|---|
| 50 |  W !,"IB(1.07) - SERVICE: ",?25,IB(1.07)
 | 
|---|
| 51 |  ;
 | 
|---|
| 52 |  W !,"<<< DATA STREAM FOR TRANSMISSION >>>",! S X="ZW IBDATA" X X
 | 
|---|
| 53 |  W !,"<<< VADPT CALL VARIABLES >>>",! S X="ZW VAIN" X X
 | 
|---|
| 54 |  Q
 | 
|---|