DVBHQUE ;ISC-ALBANY/PKE-View Hinq suspense file ; 04 OCT 85 12:46 pm
;;V4.0;HINQ;;03/25/92
SHOW S DVBVIEW=1
EN S:'$D(DVBVIEW) DVBVIEW=1 S U="^",H=1 D:'$D(IOSL) IO D HDR,QUE
;
EX K DVBVIEW,DVBSTAT,DVBUSER,DVBT,DVBTM,DVBDAY,Y0,H,DVBSHOW,DVBN,X,Y,Z,R,DFN QUIT
Q
QUE I $D(^DVB(395,1,"HQ")),+$P(^("HQ"),U,2) S DVBDAY=$P(^("HQ"),U,2),DVBDAY=9999999-DVBDAY
E S X="T-1",%DT="" D ^%DT Q:Y<0 S DVBDAY=9999999-Y
;
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
Q
;
WRTDFN I 'DVBVIEW,$D(DVBSTAT),DVBSTAT="PV" D HDR
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
;
F DVBUSER=0:0 S DVBUSER=$O(^DVB(395.5,DFN,1,DVBUSER)) Q:'DVBUSER S R(DVBUSER)="^"_$P(^(DVBUSER,0),U,2)
;
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)
;
WRTUSER 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
Q
ABS S Y0=255-Y0 Q:($Y+Y0)<(IOSL-3)
SROLL ;
W $C(7),"Press Enter to continue or '^' to escape " R X:DTIME I '$T!("^."[$E(X_1,1)) S H=0 Q
HDR S Y0=$Y W !!,"Patient",?23,"SSN",?33,"..status..time",?57,"Requested by",! Q
;
TM S Y=$E(Y,4,5)_"/"_$E(Y,6,7)_$P("@"_$E(Y_0,9,10)_":"_$E(Y_"000",11,12),"^",Y[".") Q
;
IO S IOP="HOME" D ^%ZIS K IOP Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBHQUE 1579 printed Nov 22, 2024@17:09:07 Page 2
DVBHQUE ;ISC-ALBANY/PKE-View Hinq suspense file ; 04 OCT 85 12:46 pm
+1 ;;V4.0;HINQ;;03/25/92
SHOW SET DVBVIEW=1
EN if '$DATA(DVBVIEW)
SET DVBVIEW=1
SET U="^"
SET H=1
if '$DATA(IOSL)
DO IO
DO HDR
DO QUE
+1 ;
EX KILL DVBVIEW,DVBSTAT,DVBUSER,DVBT,DVBTM,DVBDAY,Y0,H,DVBSHOW,DVBN,X,Y,Z,R,DFN
QUIT
+1 QUIT
QUE IF $DATA(^DVB(395,1,"HQ"))
IF +$PIECE(^("HQ"),U,2)
SET DVBDAY=$PIECE(^("HQ"),U,2)
SET DVBDAY=9999999-DVBDAY
+1 IF '$TEST
SET X="T-1"
SET %DT=""
DO ^%DT
if Y<0
QUIT
SET DVBDAY=9999999-Y
+2 ;
+3 FOR DVBT=0:0
if 'H
QUIT
SET DVBT=$ORDER(^DVB(395.5,"C",DVBT))
if DVBT>DVBDAY
QUIT
if 'DVBT
QUIT
FOR DFN=0:0
SET DFN=$ORDER(^DVB(395.5,"C",DVBT,DFN))
if 'DFN
QUIT
if '$DATA(^DVB(395.5,DFN,0))
QUIT
SET DVBN=^(0)
SET DVBTM=$PIECE(DVBN,U,3)
SET DVBSTAT=$PIECE(DVBN,U,4)
KILL R
DO WRTDFN
if 'H
QUIT
+4 QUIT
+5 ;
WRTDFN IF 'DVBVIEW
IF $DATA(DVBSTAT)
IF DVBSTAT="PV"
DO HDR
+1 if $DATA(^DPT(DFN,0))
WRITE !,$EXTRACT($PIECE(^(0),U,1),1,20),?22,$EXTRACT($PIECE(^(0),U,9),1,10),?34,"..",DVBSTAT,".."
SET Y=DVBTM
DO TM
WRITE Y
+2 ;
+3 FOR DVBUSER=0:0
SET DVBUSER=$ORDER(^DVB(395.5,DFN,1,DVBUSER))
if 'DVBUSER
QUIT
SET R(DVBUSER)="^"_$PIECE(^(DVBUSER,0),U,2)
+4 ;
+5 FOR DVBUSER=0:0
SET DVBUSER=$ORDER(R(DVBUSER))
if 'DVBUSER
QUIT
IF $DATA(^VA(200,DVBUSER,0))
SET $PIECE(R(DVBUSER),U,1)=$PIECE(^(0),U,1)
+6 ;
WRTUSER FOR DVBUSER=0:0
SET DVBUSER=$ORDER(R(DVBUSER))
if 'DVBUSER
QUIT
SET Y=$PIECE(R(DVBUSER),U,2)
DO TM
WRITE ?52,$EXTRACT($PIECE(R(DVBUSER),U,1),1,15),?68,Y,!
IF DVBVIEW
if $Y-Y0>(IOSL-3)
DO SROLL
if $Y<Y0
DO ABS
if 'H
QUIT
+1 QUIT
ABS SET Y0=255-Y0
if ($Y+Y0)<(IOSL-3)
QUIT
SROLL ;
+1 WRITE $CHAR(7),"Press Enter to continue or '^' to escape "
READ X:DTIME
IF '$TEST!("^."[$EXTRACT(X_1,1))
SET H=0
QUIT
HDR SET Y0=$Y
WRITE !!,"Patient",?23,"SSN",?33,"..status..time",?57,"Requested by",!
QUIT
+1 ;
TM SET Y=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_$PIECE("@"_$EXTRACT(Y_0,9,10)_":"_$EXTRACT(Y_"000",11,12),"^",Y[".")
QUIT
+1 ;
IO SET IOP="HOME"
DO ^%ZIS
KILL IOP
QUIT
