DVBHQZ4.m

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 ---DVBHQZ4   2691     printed  Mar 13, 2025@21:03:54                                                                                                                                                                                                     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