DVBHQZ4 ;ISC-ALBANY/PKE-enter in Suspense File ; Sep 30, 2021@09:08
;;4.0;HINQ;**71**;03/25/92;Build 13
Q ;Patch DVB*4.0*71 prevents VistA HINQ requests due to WEBHINQ transition
D DIV,TELL,FIND G EX
Q
FIND Q ;Patch DVB*4.0*71 prevents VistA HINQ requests due to WEBHINQ transition
S DIC="^DPT(",DIC(0)="AEMQZ" D ^DIC Q:+Y'>0 S DFN=+Y D VER W:$D(DVBVER) !,?20,"Verified" W:'$D(DVBVER) !,?15 D EN^DVBHQUT G FIND
Q ;G EX
;
EN Q ;Patch DVB*4.0*71 prevents VistA HINQ requests due to WEBHINQ transition
I $D(^DVB(395.5,DFN,0)),"PNEA"[$P(^(0),U,4) W !,$C(7),"A HINQ Request has already been made for this patient",!,"Do you wish to make another Request"
E W !,"Do you wish to request a HINQ inquiry "
AGAIN S %=2 D YN^DICN I %=1 S DVBDIV=0 D EN^DVBHQUT G EX1
I %Y'["?" G EX1
D H1 G AGAIN
;
EX K DFN,%
EX1 K X,%Y,C,D0,D1,DA,DVBO,DI,DIC,DIE,DK,DL,DOW,DR,Z,DVBDIV,DVBDIVN,Y,DVBVER,DVBSTOP,DVBKEY,DVBTIM,DVBGO,DVBZ,DVBNUM,DVBP QUIT
;
VER K DVBVER I $D(DFN),$D(^DPT(DFN,.361)),$P(^(.361),"^",1)="V" S DVBVER="" Q
Q
;
DIV S DVBDIV=0 I $D(^DVB(395,1,"HQ")),$P(^("HQ"),U,13) S DVBDIV=$P(^DG(43,1,"GL"),U,3) I DVBDIV
E Q
S DIC(0)="AZEQMN",DIC="^DG(40.8,",DIC("A")="Select Medical Center Division: ",DIC("B")=DVBDIV
S X=DVBDIV D ^DIC I +Y>0 S DVBDIV=+Y,DVBDIVN=$S($D(Y(0,0)):Y(0,0),1:$P(Y,U,2))
K DIC("A"),DIC("B") Q
;
TELL I DVBDIV,$D(DVBDIVN) W !,"The HINQ response will show the '"_DVBDIVN_"' division",!
Q
;
HINQ Q ;Patch DVB*4.0*71 prevents VistA HINQ requests due to WEBHINQ transition
I $D(DUZ)#2'=1 W !,"DUZ not defined",! Q
I $D(^VA(200,DUZ,.1)) S DVBNUM=$P(^(.1),U,9) I DVBNUM
E W !," HINQ Employee Number not in New Person file",!," Notify System Manager",! Q
S DVBGO=0
W !!,"Select patients, enter your Password and HINQ requests will be sent",!
;
D DIV,TELL,AGN G EX
;
AGN S DIC="^DPT(",DIC(0)="AEMQZ" D ^DIC I +Y>0 S DVBGO=DVBGO+1,DFN=+Y D VER W:$D(DVBVER) !,?25,"Verified"
G:Y'>0 PAS
I $D(^DVB(395.5,DFN,0)),"PNE"[$P(^(0),U,4) W !,$C(7),"A HINQ Request has already been made for this patient",!,"Do you wish to make another Request"
E D ^DVBHQUT G AGN
ASK S %=2 D YN^DICN I %=1 S DVBGO=DVBGO+1 D ^DVBHQUT G AGN
I %Y["?" D H2 G ASK
I %=2 S DVBGO=DVBGO-1 G AGN
PAS I DVBGO>0 W ! D PASS^DVBHQDB
Q ;G EX
;
H1 W !!,"Answer 'Y'es to enter a Request in the HINQ suspense File" D H3 Q
;
H2 W !!,"Answer 'Y'es to enter a Request in the HINQ suspense File" W:DVBDIV !,"The HINQ responses will show the '"_DVBDIVN_"' Division"
W !,"When you enter the HINQ password all 'P'ending requests in the",!,"HINQ suspense file will be processed"
;
H3 W !!,"Do you wish to request a HINQ inquiry " Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBHQZ4 2691 printed Oct 16, 2024@17:59:52 Page 2
DVBHQZ4 ;ISC-ALBANY/PKE-enter in Suspense File ; Sep 30, 2021@09:08
+1 ;;4.0;HINQ;**71**;03/25/92;Build 13
+2 ;Patch DVB*4.0*71 prevents VistA HINQ requests due to WEBHINQ transition
QUIT
+3 DO DIV
DO TELL
DO FIND
GOTO EX
+4 QUIT
FIND ;Patch DVB*4.0*71 prevents VistA HINQ requests due to WEBHINQ transition
QUIT
+1 SET DIC="^DPT("
SET DIC(0)="AEMQZ"
DO ^DIC
if +Y'>0
QUIT
SET DFN=+Y
DO VER
if $DATA(DVBVER)
WRITE !,?20,"Verified"
if '$DATA(DVBVER)
WRITE !,?15
DO EN^DVBHQUT
GOTO FIND
+2 ;G EX
QUIT
+3 ;
EN ;Patch DVB*4.0*71 prevents VistA HINQ requests due to WEBHINQ transition
QUIT
+1 IF $DATA(^DVB(395.5,DFN,0))
IF "PNEA"[$PIECE(^(0),U,4)
WRITE !,$CHAR(7),"A HINQ Request has already been made for this patient",!,"Do you wish to make another Request"
+2 IF '$TEST
WRITE !,"Do you wish to request a HINQ inquiry "
AGAIN SET %=2
DO YN^DICN
IF %=1
SET DVBDIV=0
DO EN^DVBHQUT
GOTO EX1
+1 IF %Y'["?"
GOTO EX1
+2 DO H1
GOTO AGAIN
+3 ;
EX KILL DFN,%
EX1 KILL X,%Y,C,D0,D1,DA,DVBO,DI,DIC,DIE,DK,DL,DOW,DR,Z,DVBDIV,DVBDIVN,Y,DVBVER,DVBSTOP,DVBKEY,DVBTIM,DVBGO,DVBZ,DVBNUM,DVBP
QUIT
+1 ;
VER KILL DVBVER
IF $DATA(DFN)
IF $DATA(^DPT(DFN,.361))
IF $PIECE(^(.361),"^",1)="V"
SET DVBVER=""
QUIT
+1 QUIT
+2 ;
DIV SET DVBDIV=0
IF $DATA(^DVB(395,1,"HQ"))
IF $PIECE(^("HQ"),U,13)
SET DVBDIV=$PIECE(^DG(43,1,"GL"),U,3)
IF DVBDIV
+1 IF '$TEST
QUIT
+2 SET DIC(0)="AZEQMN"
SET DIC="^DG(40.8,"
SET DIC("A")="Select Medical Center Division: "
SET DIC("B")=DVBDIV
+3 SET X=DVBDIV
DO ^DIC
IF +Y>0
SET DVBDIV=+Y
SET DVBDIVN=$SELECT($DATA(Y(0,0)):Y(0,0),1:$PIECE(Y,U,2))
+4 KILL DIC("A"),DIC("B")
QUIT
+5 ;
TELL IF DVBDIV
IF $DATA(DVBDIVN)
WRITE !,"The HINQ response will show the '"_DVBDIVN_"' division",!
+1 QUIT
+2 ;
HINQ ;Patch DVB*4.0*71 prevents VistA HINQ requests due to WEBHINQ transition
QUIT
+1 IF $DATA(DUZ)#2'=1
WRITE !,"DUZ not defined",!
QUIT
+2 IF $DATA(^VA(200,DUZ,.1))
SET DVBNUM=$PIECE(^(.1),U,9)
IF DVBNUM
+3 IF '$TEST
WRITE !," HINQ Employee Number not in New Person file",!," Notify System Manager",!
QUIT
+4 SET DVBGO=0
+5 WRITE !!,"Select patients, enter your Password and HINQ requests will be sent",!
+6 ;
+7 DO DIV
DO TELL
DO AGN
GOTO EX
+8 ;
AGN SET DIC="^DPT("
SET DIC(0)="AEMQZ"
DO ^DIC
IF +Y>0
SET DVBGO=DVBGO+1
SET DFN=+Y
DO VER
if $DATA(DVBVER)
WRITE !,?25,"Verified"
+1 if Y'>0
GOTO PAS
+2 IF $DATA(^DVB(395.5,DFN,0))
IF "PNE"[$PIECE(^(0),U,4)
WRITE !,$CHAR(7),"A HINQ Request has already been made for this patient",!,"Do you wish to make another Request"
+3 IF '$TEST
DO ^DVBHQUT
GOTO AGN
ASK SET %=2
DO YN^DICN
IF %=1
SET DVBGO=DVBGO+1
DO ^DVBHQUT
GOTO AGN
+1 IF %Y["?"
DO H2
GOTO ASK
+2 IF %=2
SET DVBGO=DVBGO-1
GOTO AGN
PAS IF DVBGO>0
WRITE !
DO PASS^DVBHQDB
+1 ;G EX
QUIT
+2 ;
H1 WRITE !!,"Answer 'Y'es to enter a Request in the HINQ suspense File"
DO H3
QUIT
+1 ;
H2 WRITE !!,"Answer 'Y'es to enter a Request in the HINQ suspense File"
if DVBDIV
WRITE !,"The HINQ responses will show the '"_DVBDIVN_"' Division"
+1 WRITE !,"When you enter the HINQ password all 'P'ending requests in the",!,"HINQ suspense file will be processed"
+2 ;
H3 WRITE !!,"Do you wish to request a HINQ inquiry "
QUIT
