- DVBHQSE ;ISC-ALBANY/PKE-Select view Hinq suspense file ; 04 OCT 85 12:46 pm
- ;;V4.0;HINQ;;03/25/92
- SHOW S DVBVIEW=1,DVBTSK=0,U="^",H=1
- ;
- SEL S DVBSEL=""
- W !,"Do you wish to "_$S(DVBVIEW:"view ",1:"see ")_$S(DVBVIEW:"all ",1:"pending and IDCU ")_"entries ? "_$S(DVBVIEW:"ALL",1:"PENDING & ABBREVIATED")_"// " R X:DTIME
- G:'$T!(X["^") EX
- I "AENP"[$E(X_1) S DVBSEL=X
- I X="ALL"!(X=""),DVBVIEW S DVBSEL="AENP"
- I X="?" W !,"Enter ALL or first letter(s) of file status you wish to see " G SEL
- I DVBSEL=""!(X="??") W !,"Enter 'A'bbreviated, 'P'ending, 'N'ew mail, 'E'rror " G SEL
- ;
- S %ZIS="FMQ" D ^%ZIS G EX:POP I $D(IO("C"))!($D(IO("Q"))) D TSK,^%ZTLOAD X ^%ZIS("C") G EX
- U IO D HDR,LIST X ^%ZIS("C")
- ;
- EX K DVBVIEW,DVBSTAT,DVBUSER,DVBT,DVBTM,DVBDAY,Y0,H,DVBSHOW,DVBN,X,Y,Z,R,IO("C"),IO("Q"),DVBSEL,DVBTSK,DFN,ZTSK,POP
- Q
- QUE S U="^",H=1,DVBVIEW=1,DVBTSK=ZTSK D HDR,LIST G EX
- ;
- LIST F DVBT=0:0 Q:'H S DVBT=$O(^DVB(395.5,"C",DVBT)) 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) I DVBSEL[DVBSTAT 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>(IOSL-6) SROLL
- Q
- ABS S Y0=255-Y0 Q:($Y+Y0)<(IOSL-2)
- SROLL ;
- I IOST["C",'DVBTSK W $C(7),"Press Enter to continue or '^' to escape " R X:DTIME I '$T!("^."[$E(X_1,1)) S H=0 Q
- HDR W @IOF 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
- ;
- Q
- TSK K IO("C"),IO("Q") X ^%ZOSF("UCI") S ZTUCI=Y,ZTRTN="QUE^DVBHQSE",ZTSAVE("DVBSEL")="",ZTDESC="This job is the select view of the HINQ Suspense file."
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBHQSE 2187 printed Mar 13, 2025@21:03:47 Page 2
- DVBHQSE ;ISC-ALBANY/PKE-Select view Hinq suspense file ; 04 OCT 85 12:46 pm
- +1 ;;V4.0;HINQ;;03/25/92
- SHOW SET DVBVIEW=1
- SET DVBTSK=0
- SET U="^"
- SET H=1
- +1 ;
- SEL SET DVBSEL=""
- +1 WRITE !,"Do you wish to "_$SELECT(DVBVIEW:"view ",1:"see ")_$SELECT(DVBVIEW:"all ",1:"pending and IDCU ")_"entries ? "_$SELECT(DVBVIEW:"ALL",1:"PENDING & ABBREVIATED")_"// "
- READ X:DTIME
- +2 if '$TEST!(X["^")
- GOTO EX
- +3 IF "AENP"[$EXTRACT(X_1)
- SET DVBSEL=X
- +4 IF X="ALL"!(X="")
- IF DVBVIEW
- SET DVBSEL="AENP"
- +5 IF X="?"
- WRITE !,"Enter ALL or first letter(s) of file status you wish to see "
- GOTO SEL
- +6 IF DVBSEL=""!(X="??")
- WRITE !,"Enter 'A'bbreviated, 'P'ending, 'N'ew mail, 'E'rror "
- GOTO SEL
- +7 ;
- +8 SET %ZIS="FMQ"
- DO ^%ZIS
- if POP
- GOTO EX
- IF $DATA(IO("C"))!($DATA(IO("Q")))
- DO TSK
- DO ^%ZTLOAD
- XECUTE ^%ZIS("C")
- GOTO EX
- +9 USE IO
- DO HDR
- DO LIST
- XECUTE ^%ZIS("C")
- +10 ;
- EX KILL DVBVIEW,DVBSTAT,DVBUSER,DVBT,DVBTM,DVBDAY,Y0,H,DVBSHOW,DVBN,X,Y,Z,R,IO("C"),IO("Q"),DVBSEL,DVBTSK,DFN,ZTSK,POP
- +1 QUIT
- QUE SET U="^"
- SET H=1
- SET DVBVIEW=1
- SET DVBTSK=ZTSK
- DO HDR
- DO LIST
- GOTO EX
- +1 ;
- LIST FOR DVBT=0:0
- if 'H
- QUIT
- SET DVBT=$ORDER(^DVB(395.5,"C",DVBT))
- 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)
- IF DVBSEL[DVBSTAT
- KILL R
- DO WRTDFN
- if 'H
- QUIT
- +1 QUIT
- +2 ;
- 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 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)
- +5 ;
- 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,!
- +1 IF DVBVIEW
- if $Y>(IOSL-6)
- DO SROLL
- +2 QUIT
- ABS SET Y0=255-Y0
- if ($Y+Y0)<(IOSL-2)
- QUIT
- SROLL ;
- +1 IF IOST["C"
- IF 'DVBTSK
- WRITE $CHAR(7),"Press Enter to continue or '^' to escape "
- READ X:DTIME
- IF '$TEST!("^."[$EXTRACT(X_1,1))
- SET H=0
- QUIT
- HDR WRITE @IOF
- 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 ;
- +2 QUIT
- TSK KILL IO("C"),IO("Q")
- XECUTE ^%ZOSF("UCI")
- SET ZTUCI=Y
- SET ZTRTN="QUE^DVBHQSE"
- SET ZTSAVE("DVBSEL")=""
- SET ZTDESC="This job is the select view of the HINQ Suspense file."
- +1 QUIT
