- 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 Feb 18, 2025@23:25:20 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
