DVBHQST ;ISC-ALBANY/PKE/PHH-Process HINQ response ; 3/23/06 7:59am
;;4.0;HINQ;**32,57**;03/25/92
A S DFN=DVBDFN D:'$D(DT) DT^DICRW I $D(X(1)),$E(X(1),1,4)'="HINQ" G NETERR
;
I $D(X)#2,$E(X,1,4)="HINQ" S DVBREQST=$E(X,24,$L(X)-8) K:'$L(DVBREQST) DVBREQST
;
G Q:'$D(X(1)) I "456789ABCDUVWZ"'[$E(X(1),5) G N:$E(X(1),6)=2,N:$E(X(1),5)=2,AB:$E(X(1),5)="N",AB:$E(X(1),5)="M",Q:$E(X(1),1,4)'="HINQ"
;
S $P(DVBSP," ",35)="",DVBNM=$P(^DPT(DFN,0),U)_DVBSP,DVBNB=" "_DFN_DVBSP,Y=$E(X(1),5),DVBECT=DVBECT+1,DVBSTATS="E" D ERR S DVBTXT(DVBPCT,0)=" "_$E(DVBNM,1,20)_$E(DVBNB,1,11)_Y,DVBPCT=DVBPCT+1 D SET^DVBHQUT Q
;
ERR I "BC"[Y D RETRY^DVBHIQR Q
;I Y="C" S Y="No Record matches data requested, Retry using CN. or SN. via 'Individual HINQ'." Q
I Y=6 S Y="Invalid Employee number Not AUTHORIZED" Q
I Y=9 S Y="PASSWORD missing or invalid" Q
I Y="X" S Y="Station # does not match Station # of password " Q
I Y="Y" S Y="Employee Number in New Person file doesn't match the # in VBA security record" Q
;
S Y=$S(Y=4:"File in alert, NOT available",Y=5:"NO C&P record found ",Y=7:"SS # missing or invalid.",Y=8:"NAME missing or invalid.",1:Y) Q:Y'?1U
;
S Y=$S(Y="A":"File NOT available",Y="D":"SENSITIVE File no access authorized",Y="U":"Unsuccessful read of password or sensitive file",Y="V":"Invalid CLAIM NUMBER",Y="W":"Invalid SERVICE NUMBER",1:Y)
Q
Q K DVBOTM,DVBV,DVBOXMZ,DVBIXMZ,XMORIG QUIT
;
NETERR ;
S:'$D(DVBZ) DVBZ=^DVB(395.5,DFN,"HQ") S DVBSTATS="V",XMORIG=DUZ,XMDUZ=.5,XMSUB="IDCU Response for ",DVBREQUE="",DFN=+$E(DVBZ,10,21),DVBNETER=X(1) D SET^DVBHQUT Q
G Q
AB S DVBACT=DVBACT+1 D EN^DVBHQR3,EN^DVBHIQM Q
N S DVBSTATS="N" D SET^DVBHQUT Q
;
SC ;CHECK SUM need to set DVBCS=0,X(n),DVBSZ
N DA
I $D(X)#2 S DVBSX=X
I DVBSZ=1 S X=$E(X(DVBSZ),1,21)_$E(X(DVBSZ),26,999),DVBXLN=$E(X(DVBSZ),22,25) D O D Q
.;compare ien of file #395.5 (i.e., dfn) and $e(x(1),8,21)
.;quit if entering from hinq processor either foreground or background
.;only want to do this deletion during print/display of hinq response data
.Q:+$G(DVBTSK) Q:+$G(DFN)=0
.Q:'$D(^DVB(395.5,DFN,"RS",1))
.S DVBQDFN=+$E(X(1),8,21) I DVBQDFN'=DFN D
..;if not a match, then delete entry from file #395.5 and send error message
..S JJ=$O(^DVB(395,1,"HQMG",0)),DVBQMG=$P($G(^DVB(395,1,"HQMG",JJ,0)),U,1),DVBQMG=$P($G(^XMB(3.8,DVBQMG,0)),U,1)
..S DA=DFN,DIK="^DVB(395.5," D ^DIK
..S JJ=1
..S ^TMP($J,"DVBQERR",JJ)="Record #"_DFN_" in the HINQ SUSPENSE file (#395.5)" S JJ=JJ+1
..S ^TMP($J,"DVBQERR",JJ)="has been deleted." S JJ=JJ+1
..S ^TMP($J,"DVBQERR",JJ)=" " S JJ=JJ+1
..S ^TMP($J,"DVBQERR",JJ)="This record should have contained HINQ response data on:" S JJ=JJ+1
..S ^TMP($J,"DVBQERR",JJ)=" " S JJ=JJ+1
..S DVBQIENS=DFN_"," D GETS^DIQ(2,DVBQIENS,".01;.03;.09","E","DVBQA","DVBQE")
..S ^TMP($J,"DVBQERR",JJ)="Name: "_$G(DVBQA(2,DVBQIENS,.01,"E")) S JJ=JJ+1
..S ^TMP($J,"DVBQERR",JJ)=" DOB: "_$G(DVBQA(2,DVBQIENS,.03,"E")) S JJ=JJ+1
..S ^TMP($J,"DVBQERR",JJ)=" SSN: "_$G(DVBQA(2,DVBQIENS,.09,"E")) S JJ=JJ+1
..S ^TMP($J,"DVBQERR",JJ)=" " S JJ=JJ+1
..K DVBQA,DVBQE
..S ^TMP($J,"DVBQERR",JJ)="Instead it held HINQ response data for:" S JJ=JJ+1
..S ^TMP($J,"DVBQERR",JJ)=" " S JJ=JJ+1
..S DVBQIENS=DVBQDFN_"," D GETS^DIQ(2,DVBQIENS,".01;.03;.09","E","DVBQA","DVBQE")
..S ^TMP($J,"DVBQERR",JJ)="Name: "_$G(DVBQA(2,DVBQIENS,.01,"E")) S JJ=JJ+1
..S ^TMP($J,"DVBQERR",JJ)=" DOB: "_$G(DVBQA(2,DVBQIENS,.03,"E")) S JJ=JJ+1
..S ^TMP($J,"DVBQERR",JJ)=" SSN: "_$G(DVBQA(2,DVBQIENS,.09,"E")) S JJ=JJ+1
..S ^TMP($J,"DVBQERR",JJ)=" " S JJ=JJ+1
..S ^TMP($J,"DVBQERR",JJ)="Please request new HINQ data on the appropriate veteran" S JJ=JJ+1
..S ^TMP($J,"DVBQERR",JJ)="at your earliest convenience." S JJ=JJ+1
..S XMDUZ=DUZ,XMSUB="HINQ Suspense File IEN#"_DFN_" Deleted",XMTEXT="^TMP($J,""DVBQERR"","
..S XMY(DUZ)="" S:DVBQMG'="" XMY("G."_DVBQMG)=""
..D ^XMD K XMZ
..S DVBERCS=1 K DVBQDFN,DVBQIENS,DVBQA,DVBQE,DVBQMG,DIK,JJ
I DVBSZ>1 S X=$E(X(DVBSZ),1,999) D O Q
I 'DVBSZ S DVBCS="0000"_DVBCS,DVBCS=$E(DVBCS,($L(DVBCS)-3),$L(DVBCS)) I '$D(DVBECS) S ^(0)=$E(^DVB(395.5,DVBDFN,"RS",1,0),1,21)_DVBCS_$E(^(0),26,999)
I DVBXLN'=DVBCS,$D(DVBECS) S:'$D(DVBON) (DVBON,DVBOFF)="""""" D W1
I $D(DVBSX) S X=DVBSX
D EX
Q
;
EX K DVBXLN,DVBSX Q
;
O X ^%ZOSF("LPC") S DVBCS=(DVBCS+Y+$L(X))*DVBSZ
Q
;
W1 U IO W !!!!,*7,?15,"HINQ data does NOT seem right",!,?15,"Re-HINQ and/or Notify system manager. ",!,?15,"HINQ check sum failure for ",DVBON,$S($D(^DPT(DFN,0)):$P(^(0),U),1:DFN),DVBOFF,! H 3 S DVBERCS=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBHQST 4584 printed Sep 23, 2025@19:35:05 Page 2
DVBHQST ;ISC-ALBANY/PKE/PHH-Process HINQ response ; 3/23/06 7:59am
+1 ;;4.0;HINQ;**32,57**;03/25/92
A SET DFN=DVBDFN
if '$DATA(DT)
DO DT^DICRW
IF $DATA(X(1))
IF $EXTRACT(X(1),1,4)'="HINQ"
GOTO NETERR
+1 ;
+2 IF $DATA(X)#2
IF $EXTRACT(X,1,4)="HINQ"
SET DVBREQST=$EXTRACT(X,24,$LENGTH(X)-8)
if '$LENGTH(DVBREQST)
KILL DVBREQST
+3 ;
+4 if '$DATA(X(1))
GOTO Q
IF "456789ABCDUVWZ"'[$EXTRACT(X(1),5)
if $EXTRACT(X(1),6)=2
GOTO N
if $EXTRACT(X(1),5)=2
GOTO N
if $EXTRACT(X(1),5)="N"
GOTO AB
if $EXTRACT(X(1),5)="M"
GOTO AB
if $EXTRACT(X(1),1,4)'="HINQ"
GOTO Q
+5 ;
+6 SET $PIECE(DVBSP," ",35)=""
SET DVBNM=$PIECE(^DPT(DFN,0),U)_DVBSP
SET DVBNB=" "_DFN_DVBSP
SET Y=$EXTRACT(X(1),5)
SET DVBECT=DVBECT+1
SET DVBSTATS="E"
DO ERR
SET DVBTXT(DVBPCT,0)=" "_$EXTRACT(DVBNM,1,20)_$EXTRACT(DVBNB,1,11)_Y
SET DVBPCT=DVBPCT+1
DO SET^DVBHQUT
QUIT
+7 ;
ERR IF "BC"[Y
DO RETRY^DVBHIQR
QUIT
+1 ;I Y="C" S Y="No Record matches data requested, Retry using CN. or SN. via 'Individual HINQ'." Q
+2 IF Y=6
SET Y="Invalid Employee number Not AUTHORIZED"
QUIT
+3 IF Y=9
SET Y="PASSWORD missing or invalid"
QUIT
+4 IF Y="X"
SET Y="Station # does not match Station # of password "
QUIT
+5 IF Y="Y"
SET Y="Employee Number in New Person file doesn't match the # in VBA security record"
QUIT
+6 ;
+7 SET Y=$SELECT(Y=4:"File in alert, NOT available",Y=5:"NO C&P record found ",Y=7:"SS # missing or invalid.",Y=8:"NAME missing or invalid.",1:Y)
if Y'?1U
QUIT
+8 ;
+9 SET Y=$SELECT(Y="A":"File NOT available",Y="D":"SENSITIVE File no access authorized",Y="U":"Unsuccessful read of password or sensitive file",Y="V":"Invalid CLAIM NUMBER",Y="W":"Invalid SERVICE NUMBER",1:Y)
+10 QUIT
Q KILL DVBOTM,DVBV,DVBOXMZ,DVBIXMZ,XMORIG
QUIT
+1 ;
NETERR ;
+1 if '$DATA(DVBZ)
SET DVBZ=^DVB(395.5,DFN,"HQ")
SET DVBSTATS="V"
SET XMORIG=DUZ
SET XMDUZ=.5
SET XMSUB="IDCU Response for "
SET DVBREQUE=""
SET DFN=+$EXTRACT(DVBZ,10,21)
SET DVBNETER=X(1)
DO SET^DVBHQUT
QUIT
+2 GOTO Q
AB SET DVBACT=DVBACT+1
DO EN^DVBHQR3
DO EN^DVBHIQM
QUIT
N SET DVBSTATS="N"
DO SET^DVBHQUT
QUIT
+1 ;
SC ;CHECK SUM need to set DVBCS=0,X(n),DVBSZ
+1 NEW DA
+2 IF $DATA(X)#2
SET DVBSX=X
+3 IF DVBSZ=1
SET X=$EXTRACT(X(DVBSZ),1,21)_$EXTRACT(X(DVBSZ),26,999)
SET DVBXLN=$EXTRACT(X(DVBSZ),22,25)
DO O
Begin DoDot:1
+4 ;compare ien of file #395.5 (i.e., dfn) and $e(x(1),8,21)
+5 ;quit if entering from hinq processor either foreground or background
+6 ;only want to do this deletion during print/display of hinq response data
+7 if +$GET(DVBTSK)
QUIT
if +$GET(DFN)=0
QUIT
+8 if '$DATA(^DVB(395.5,DFN,"RS",1))
QUIT
+9 SET DVBQDFN=+$EXTRACT(X(1),8,21)
IF DVBQDFN'=DFN
Begin DoDot:2
+10 ;if not a match, then delete entry from file #395.5 and send error message
+11 SET JJ=$ORDER(^DVB(395,1,"HQMG",0))
SET DVBQMG=$PIECE($GET(^DVB(395,1,"HQMG",JJ,0)),U,1)
SET DVBQMG=$PIECE($GET(^XMB(3.8,DVBQMG,0)),U,1)
+12 SET DA=DFN
SET DIK="^DVB(395.5,"
DO ^DIK
+13 SET JJ=1
+14 SET ^TMP($JOB,"DVBQERR",JJ)="Record #"_DFN_" in the HINQ SUSPENSE file (#395.5)"
SET JJ=JJ+1
+15 SET ^TMP($JOB,"DVBQERR",JJ)="has been deleted."
SET JJ=JJ+1
+16 SET ^TMP($JOB,"DVBQERR",JJ)=" "
SET JJ=JJ+1
+17 SET ^TMP($JOB,"DVBQERR",JJ)="This record should have contained HINQ response data on:"
SET JJ=JJ+1
+18 SET ^TMP($JOB,"DVBQERR",JJ)=" "
SET JJ=JJ+1
+19 SET DVBQIENS=DFN_","
DO GETS^DIQ(2,DVBQIENS,".01;.03;.09","E","DVBQA","DVBQE")
+20 SET ^TMP($JOB,"DVBQERR",JJ)="Name: "_$GET(DVBQA(2,DVBQIENS,.01,"E"))
SET JJ=JJ+1
+21 SET ^TMP($JOB,"DVBQERR",JJ)=" DOB: "_$GET(DVBQA(2,DVBQIENS,.03,"E"))
SET JJ=JJ+1
+22 SET ^TMP($JOB,"DVBQERR",JJ)=" SSN: "_$GET(DVBQA(2,DVBQIENS,.09,"E"))
SET JJ=JJ+1
+23 SET ^TMP($JOB,"DVBQERR",JJ)=" "
SET JJ=JJ+1
+24 KILL DVBQA,DVBQE
+25 SET ^TMP($JOB,"DVBQERR",JJ)="Instead it held HINQ response data for:"
SET JJ=JJ+1
+26 SET ^TMP($JOB,"DVBQERR",JJ)=" "
SET JJ=JJ+1
+27 SET DVBQIENS=DVBQDFN_","
DO GETS^DIQ(2,DVBQIENS,".01;.03;.09","E","DVBQA","DVBQE")
+28 SET ^TMP($JOB,"DVBQERR",JJ)="Name: "_$GET(DVBQA(2,DVBQIENS,.01,"E"))
SET JJ=JJ+1
+29 SET ^TMP($JOB,"DVBQERR",JJ)=" DOB: "_$GET(DVBQA(2,DVBQIENS,.03,"E"))
SET JJ=JJ+1
+30 SET ^TMP($JOB,"DVBQERR",JJ)=" SSN: "_$GET(DVBQA(2,DVBQIENS,.09,"E"))
SET JJ=JJ+1
+31 SET ^TMP($JOB,"DVBQERR",JJ)=" "
SET JJ=JJ+1
+32 SET ^TMP($JOB,"DVBQERR",JJ)="Please request new HINQ data on the appropriate veteran"
SET JJ=JJ+1
+33 SET ^TMP($JOB,"DVBQERR",JJ)="at your earliest convenience."
SET JJ=JJ+1
+34 SET XMDUZ=DUZ
SET XMSUB="HINQ Suspense File IEN#"_DFN_" Deleted"
SET XMTEXT="^TMP($J,""DVBQERR"","
+35 SET XMY(DUZ)=""
if DVBQMG'=""
SET XMY("G."_DVBQMG)=""
+36 DO ^XMD
KILL XMZ
+37 SET DVBERCS=1
KILL DVBQDFN,DVBQIENS,DVBQA,DVBQE,DVBQMG,DIK,JJ
End DoDot:2
End DoDot:1
QUIT
+38 IF DVBSZ>1
SET X=$EXTRACT(X(DVBSZ),1,999)
DO O
QUIT
+39 IF 'DVBSZ
SET DVBCS="0000"_DVBCS
SET DVBCS=$EXTRACT(DVBCS,($LENGTH(DVBCS)-3),$LENGTH(DVBCS))
IF '$DATA(DVBECS)
SET ^(0)=$EXTRACT(^DVB(395.5,DVBDFN,"RS",1,0),1,21)_DVBCS_$EXTRACT(^(0),26,999)
+40 IF DVBXLN'=DVBCS
IF $DATA(DVBECS)
if '$DATA(DVBON)
SET (DVBON,DVBOFF)=""""""
DO W1
+41 IF $DATA(DVBSX)
SET X=DVBSX
+42 DO EX
+43 QUIT
+44 ;
EX KILL DVBXLN,DVBSX
QUIT
+1 ;
O XECUTE ^%ZOSF("LPC")
SET DVBCS=(DVBCS+Y+$LENGTH(X))*DVBSZ
+1 QUIT
+2 ;
W1 USE IO
WRITE !!!!,*7,?15,"HINQ data does NOT seem right",!,?15,"Re-HINQ and/or Notify system manager. ",!,?15,"HINQ check sum failure for ",DVBON,$SELECT($DATA(^DPT(DFN,0)):$PIECE(^(0),U),1:DFN),DVBOFF,!
HANG 3
SET DVBERCS=1
+1 QUIT
