| [613] | 1 | IBQLSCR ;LEB/MRY - SCREEN DUMP OF RAW DATA FOR DOWNLOAD SPREADSHEET ; 12-APR-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 | I '$D(DT) D DT^DICRW
|
|---|
| 6 | DATE W ! D DATE^IBOUTL
|
|---|
| 7 | I IBBDT=""!(IBEDT="") G END
|
|---|
| 8 | D SVCTAB^IBQLR1B
|
|---|
| 9 | ;
|
|---|
| 10 | W !!,"Load Data to Excel"
|
|---|
| 11 | W !!,"Set your Device settings to '0;255;9999'"
|
|---|
| 12 | DEV ; -- select device, run option
|
|---|
| 13 | W ! D ^%ZIS G:POP END
|
|---|
| 14 | S DIR(0)="FO",DIR("A")="Initiate File Capture Procedure and Press Return" D ^DIR I $D(DTOUT)!$D(DUOUT) G END
|
|---|
| 15 | W !,"Working...",!
|
|---|
| 16 | U IO
|
|---|
| 17 | ;
|
|---|
| 18 | START ;
|
|---|
| 19 | W !,"ssn^adm. diag^enrollement code^adm. phy^attend. phy^resident phy^adm. date^disch. date^ward^ts^service^acute adm.?^si^is^reasons^prov. interviewed?^adm. influenced?^day^day is^day si^day d/s^day interviewed?^day reasons^ts^service"
|
|---|
| 20 | S IBDDT=IBBDT-.01
|
|---|
| 21 | F S IBDDT=$O(^IBQ(538,"ADIS",IBDDT)) Q:'IBDDT!(IBDDT>IBEDT) D
|
|---|
| 22 | .S IBTRN=0
|
|---|
| 23 | .F S IBTRN=$O(^IBQ(538,"ADIS",IBDDT,IBTRN)) Q:'IBTRN D DATA
|
|---|
| 24 | ;
|
|---|
| 25 | END D ^%ZISC K IBTRN,POP,IBSTR,X,I,II Q
|
|---|
| 26 | ;
|
|---|
| 27 | DATA ;
|
|---|
| 28 | S IBWRAP=""
|
|---|
| 29 | S X=^IBQ(538,IBTRN,0),IBSTR="",X1=$G(^(1))
|
|---|
| 30 | F I=3:1:13 S IBSTR=IBSTR_$P(X,"^",I)_"^"
|
|---|
| 31 | S $P(IBSTR,"^",13)=$P(IBSTR,"^",12),$P(IBSTR,"^",12)=$G(IBSVC($P(X1,"^",7)))
|
|---|
| 32 | F I=1:1:5 S IBSTR=IBSTR_$P(X1,"^",I)_"^"
|
|---|
| 33 | F N=7,8 S X=$P(IBSTR,"^",N),X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3),$P(IBSTR,"^",N)=X
|
|---|
| 34 | F N=12,16,17 S X=$P(IBSTR,"^",N),X=$S(X=0:"N",X=1:"Y",1:""),$P(IBSTR,"^",N)=X
|
|---|
| 35 | S N=0 F S N=$O(^IBQ(538,IBTRN,13,N)) Q:'N F I=1:1:8 D
|
|---|
| 36 | .I I=1,$L(IBSTR)>(IOM-60) S IBWRAP=1 D PLINE
|
|---|
| 37 | .S X=$P(^IBQ(538,IBTRN,13,N,0),"^",I)
|
|---|
| 38 | .I I=5 S X=$S(X=0:"N",X=1:"Y",1:"")
|
|---|
| 39 | .I I=8 S X=$G(IBSVC(X))
|
|---|
| 40 | .S IBSTR=IBSTR_X_"^"
|
|---|
| 41 | .Q
|
|---|
| 42 | S IBSTR=$P(IBSTR,"^",1,$L(IBSTR,"^")-1)
|
|---|
| 43 | D PLINE
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | PLINE W !,IBSTR
|
|---|
| 47 | S:'IBWRAP IBSTR="" S:IBWRAP IBSTR="WRAP:DAY>",IBWRAP=""
|
|---|
| 48 | Q
|
|---|
