source: WorldVistAEHR/trunk/r/UTILIZATION_MGMT_ROLLUP_LOCAL-IBQ/IBQLSCR.m@ 1789

Last change on this file since 1789 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1IBQLSCR ;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
6DATE 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'"
12DEV ; -- 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 ;
18START ;
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 ;
25END D ^%ZISC K IBTRN,POP,IBSTR,X,I,II Q
26 ;
27DATA ;
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 ;
46PLINE W !,IBSTR
47 S:'IBWRAP IBSTR="" S:IBWRAP IBSTR="WRAP:DAY>",IBWRAP=""
48 Q
Note: See TracBrowser for help on using the repository browser.