source: WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHQUE.m@ 1639

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

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1DVBHQUE ;ISC-ALBANY/PKE-View Hinq suspense file ; 04 OCT 85 12:46 pm
2 ;;V4.0;HINQ;;03/25/92
3SHOW S DVBVIEW=1
4EN S:'$D(DVBVIEW) DVBVIEW=1 S U="^",H=1 D:'$D(IOSL) IO D HDR,QUE
5 ;
6EX K DVBVIEW,DVBSTAT,DVBUSER,DVBT,DVBTM,DVBDAY,Y0,H,DVBSHOW,DVBN,X,Y,Z,R,DFN QUIT
7 Q
8QUE I $D(^DVB(395,1,"HQ")),+$P(^("HQ"),U,2) S DVBDAY=$P(^("HQ"),U,2),DVBDAY=9999999-DVBDAY
9 E S X="T-1",%DT="" D ^%DT Q:Y<0 S DVBDAY=9999999-Y
10 ;
11 F DVBT=0:0 Q:'H S DVBT=$O(^DVB(395.5,"C",DVBT)) Q:DVBT>DVBDAY Q:'DVBT F DFN=0:0 S DFN=$O(^DVB(395.5,"C",DVBT,DFN)) Q:'DFN Q:'$D(^DVB(395.5,DFN,0)) S DVBN=^(0),DVBTM=$P(DVBN,U,3),DVBSTAT=$P(DVBN,U,4) K R D WRTDFN Q:'H
12 Q
13 ;
14WRTDFN I 'DVBVIEW,$D(DVBSTAT),DVBSTAT="PV" D HDR
15 W:$D(^DPT(DFN,0)) !,$E($P(^(0),U,1),1,20),?22,$E($P(^(0),U,9),1,10),?34,"..",DVBSTAT,".." S Y=DVBTM D TM W Y
16 ;
17 F DVBUSER=0:0 S DVBUSER=$O(^DVB(395.5,DFN,1,DVBUSER)) Q:'DVBUSER S R(DVBUSER)="^"_$P(^(DVBUSER,0),U,2)
18 ;
19 F DVBUSER=0:0 S DVBUSER=$O(R(DVBUSER)) Q:'DVBUSER I $D(^VA(200,DVBUSER,0)) S $P(R(DVBUSER),U,1)=$P(^(0),U,1)
20 ;
21WRTUSER F DVBUSER=0:0 S DVBUSER=$O(R(DVBUSER)) Q:'DVBUSER S Y=$P(R(DVBUSER),U,2) D TM W ?52,$E($P(R(DVBUSER),U,1),1,15),?68,Y,! I DVBVIEW D:$Y-Y0>(IOSL-3) SROLL D:$Y<Y0 ABS Q:'H
22 Q
23ABS S Y0=255-Y0 Q:($Y+Y0)<(IOSL-3)
24SROLL ;
25 W $C(7),"Press Enter to continue or '^' to escape " R X:DTIME I '$T!("^."[$E(X_1,1)) S H=0 Q
26HDR S Y0=$Y W !!,"Patient",?23,"SSN",?33,"..status..time",?57,"Requested by",! Q
27 ;
28TM S Y=$E(Y,4,5)_"/"_$E(Y,6,7)_$P("@"_$E(Y_0,9,10)_":"_$E(Y_"000",11,12),"^",Y[".") Q
29 ;
30IO S IOP="HOME" D ^%ZIS K IOP Q
Note: See TracBrowser for help on using the repository browser.