DVBHQDE ;ISC-ALBANY/PKE-generate HINQ direct ; 7/19/05 9:43pm
;;4.0;HINQ;**52,49,55**;03/25/92
G EN
RD R Y:DTIME IF I Y'="^",Y'["?" S:Y'="" X1(N)=Y S:Y="@" X1(N)="" S:Y="SS"&(N>2) X1(N)=X1(2) Q
S N=0 Q
;
EN ;D EN^DVBHQTM I $D(DVBSTOP) K DVBSTOP Q
F Z=1:1:4 S X1(Z)=""
S Y=-1 K Y(0)
NAM ;DVB*4*49 - name queries no longer accepted
S X1(1)=""
;
;with DVB*4*49 only one number can be entered - first choice CN,
;then SSN, then SN
TXT W !,"Enter one of the following numbers - Social Security Number, Claim Number",!,"or Service Number."
W !
D SS
I Y?9N G EDIT
I Y="^" Q
D CNUM
I Y?8.9N G EDIT
I Y="^" Q
D SNUM
G EDIT
Q
SS W !,"Social Security: ",X1(2)_$S($L(X1(2)):"// ",1:"") S N=2 D RD G SS:Y="@" I Y["?" S H=3 D HELP G SS
Q:'N
I X1(2)'="",X1(2)'?9N S X1(2)="" W $C(7) S H=4 D HELP S H=3 D HELP G SS G SS
Q
;
CNUM W !,"Claim Number: ",X1(3)_$S($L(X1(3)):"// ",1:"") S N=3 D RD G CNUM:Y="@" I Y["?" S H=10 D HELP G CNUM
Q:'N
I X1(3)'="",(X1(3)'?1N.N!($L(X1(3))<1)!($L(X1(3))>9)) S X1(3)="" S H=6 D HELP S H=7 D HELP G CNUM
Q
;
SNUM W !,"Service Number : ",X1(4)_$S($L(X1(4)):"// ",1:"") S N=4 D RD G SNUM:Y="@" S T=$L(X1(4)) I Y["?" S H=7 D HELP G SNUM
Q:'N
I X1(4)'="",(X1(4)'?1N.N!($L(X1(4))<4)!($L(X1(4))>9)) S X1(4)="" W $C(7) S H=8 D HELP S H=7 D HELP G SNUM
Q
;
EDIT W !,?4," OK " S %=1 D YN^DICN
Q:%Y="^" G:"Yy"[%Y CHK
G:"Nn"[$E(%Y_1) NAM
I %Y["?" W ?17 S H=9 D HELP G EDIT
Q
;
CHK I X1(1)="",X1(2)="",X1(3)="",X1(4)="" Q
S $P(Y(0),U,1)=X1(1)
S $P(Y(0),U,9)=X1(2)
S DVBCN=X1(3)
S DVBSN=X1(4)
;
PASS X ^%ZOSF("EOFF") R !,"Enter HINQ PASSWORD: ",DVBP:DTIME X ^%ZOSF("EON") S:'$T DVBP="^" Q:'$T!("^."[DVBP) S X=DVBP X ^DD("FUNC",13,1) S DVBP=X I DVBP'?4E W !,*7,"Please enter 4 characters." G PASS
;VBA has changed the format of the HINQ password to allow numbers and
;special characters - DVB*4*55,ERC
;
BYPASS S DFN="XXXZ"
N I,I1,I2,I3,I4,I5
I '$D(Y(0)) S Y=-1 Q
S DVBNAM=$P(Y(0),"^",1),I=$P(DVBNAM,","),I2=$P(DVBNAM,",",2)
F J=$L(I):-1:0 Q:$E(I,J)?1A S I=$E(I,1,J-1)
F J=1:1 Q:$F(I," ")=0 S K=$F(I," "),I4=$E(I,K,99),I=$E(I,1,K-2)
I $D(I4),$L(I4)<4 S I5=""
E I $D(I4),$L(I4)>3 I "SRJRIII"[$P(I4," ",2) S:"SRJRIII"'[$P(I4," ") I5=$P(I4," ") S I4=$P(I4," ",2)
I $D(I4),I4=" " K I4
I $D(I4) F J=$L(I4):-1:0 Q:$E(I4,J)'=" " S I4=$E(I4,1,J-1)
I '$D(I5),$D(I4) S I5=I4 K I4
F J=0:0 Q:$E(I2)'=" " S I2=$E(I2,2,99)
F J=$L(I2):-1:0 Q:$E(I2,J)'=" " S I2=$E(I2,1,J-1)
I I2[" " S I3=$P(I2," ",2,99),I2=$P(I2," ") F J=0:0 Q:$E(I3)'=" " S I3=$E(I3,2,99)
I '$D(I4),$D(I3) S I4=$P(I3," ",2),I3=$P(I3," ",1)
S DVBNAM=I_$S($D(I5):I5,1:"")_","_I2_$S($D(I3):","_I3,1:"")_$S($D(I4):","_I4,1:"")
I DVBNAM["'" S DVBNAM=$P(DVBNAM,"'")_$P(DVBNAM,"'",2)
I DVBNAM["." S DVBNAM=$P(DVBNAM,".")_$P(DVBNAM,".",2)
I DVBNAM["(" S DVBNAM=$P(DVBNAM,"(")
I DVBNAM?1"," S DVBNAM=""
S:DVBNAM]"" DVBNAM="NM"_$E(DVBNAM,1,30)_"/"
I $D(^DVB(395,1,0)) S DVBSTN=$P(^DVB(395,1,0),U,2) Q:'DVBSTN
E W !,*7,"Station number not defined in HINQ Parameters file." Q
ST ;;;CHANGED P TO E FOR TESTING NEW STRING
S DVBZ="HINQ"_DVBSTN_" "_"E"_$S($P(Y(0),"^",9)]""&($P(Y(0),"^",9)'["P"):"SS"_$P(Y(0),"^",9),1:"")_DVBNAM
CN S I=DVBCN G SN:I="" F J=1:1 Q:$L(I)'<8 S I=0_I
S:$L(I)=8 I=" "_I S DVBZ=DVBZ_"CN"_I
SN S I=DVBSN G VDI:I="" F J=1:1 Q:$L(I)'<8 S I=0_I
S:$L(I)=8 I=" "_I S DVBZ=DVBZ_"SN"_I
;
VDI S DVBZ=DVBZ_DVBNUM_DVBP,DVBZ=$E(DVBZ,1,9)_" "_$E(DVBZ,10,999)
;
S Y=0 K %Y,I,I1,I2,I3,I4,I5,DVBNAM,DVBSTN,DVBTGT,Y(0) QUIT
;
HELP W " ",$P($T(HELP+H),";;",2) K H Q
;;Enter last name,first name up to 30 characters
;;At the last prompt ' OK ? YES// ' you may enter No to edit
;;Enter 9 digits only
;;Bad SSN
;;Enter 1-9 digits or SS for Social Security
;;Bad Claim #
;;Enter 4-9 digits or SS for Social Security
;;Bad Service #
;;Enter No to edit data Return to continue
;;Identifying Number must be 1 - 9 digits
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBHQDE 3980 printed Dec 13, 2024@01:58:37 Page 2
DVBHQDE ;ISC-ALBANY/PKE-generate HINQ direct ; 7/19/05 9:43pm
+1 ;;4.0;HINQ;**52,49,55**;03/25/92
+2 GOTO EN
RD READ Y:DTIME
IF $TEST
IF Y'="^"
IF Y'["?"
if Y'=""
SET X1(N)=Y
if Y="@"
SET X1(N)=""
if Y="SS"&(N>2)
SET X1(N)=X1(2)
QUIT
+1 SET N=0
QUIT
+2 ;
EN ;D EN^DVBHQTM I $D(DVBSTOP) K DVBSTOP Q
+1 FOR Z=1:1:4
SET X1(Z)=""
+2 SET Y=-1
KILL Y(0)
NAM ;DVB*4*49 - name queries no longer accepted
+1 SET X1(1)=""
+2 ;
+3 ;with DVB*4*49 only one number can be entered - first choice CN,
+4 ;then SSN, then SN
TXT WRITE !,"Enter one of the following numbers - Social Security Number, Claim Number",!,"or Service Number."
+1 WRITE !
+2 DO SS
+3 IF Y?9N
GOTO EDIT
+4 IF Y="^"
QUIT
+5 DO CNUM
+6 IF Y?8.9N
GOTO EDIT
+7 IF Y="^"
QUIT
+8 DO SNUM
+9 GOTO EDIT
+10 QUIT
SS WRITE !,"Social Security: ",X1(2)_$SELECT($LENGTH(X1(2)):"// ",1:"")
SET N=2
DO RD
if Y="@"
GOTO SS
IF Y["?"
SET H=3
DO HELP
GOTO SS
+1 if 'N
QUIT
+2 IF X1(2)'=""
IF X1(2)'?9N
SET X1(2)=""
WRITE $CHAR(7)
SET H=4
DO HELP
SET H=3
DO HELP
GOTO SS
GOTO SS
+3 QUIT
+4 ;
CNUM WRITE !,"Claim Number: ",X1(3)_$SELECT($LENGTH(X1(3)):"// ",1:"")
SET N=3
DO RD
if Y="@"
GOTO CNUM
IF Y["?"
SET H=10
DO HELP
GOTO CNUM
+1 if 'N
QUIT
+2 IF X1(3)'=""
IF (X1(3)'?1N.N!($LENGTH(X1(3))<1)!($LENGTH(X1(3))>9))
SET X1(3)=""
SET H=6
DO HELP
SET H=7
DO HELP
GOTO CNUM
+3 QUIT
+4 ;
SNUM WRITE !,"Service Number : ",X1(4)_$SELECT($LENGTH(X1(4)):"// ",1:"")
SET N=4
DO RD
if Y="@"
GOTO SNUM
SET T=$LENGTH(X1(4))
IF Y["?"
SET H=7
DO HELP
GOTO SNUM
+1 if 'N
QUIT
+2 IF X1(4)'=""
IF (X1(4)'?1N.N!($LENGTH(X1(4))<4)!($LENGTH(X1(4))>9))
SET X1(4)=""
WRITE $CHAR(7)
SET H=8
DO HELP
SET H=7
DO HELP
GOTO SNUM
+3 QUIT
+4 ;
EDIT WRITE !,?4," OK "
SET %=1
DO YN^DICN
+1 if %Y="^"
QUIT
if "Yy"[%Y
GOTO CHK
+2 if "Nn"[$EXTRACT(%Y_1)
GOTO NAM
+3 IF %Y["?"
WRITE ?17
SET H=9
DO HELP
GOTO EDIT
+4 QUIT
+5 ;
CHK IF X1(1)=""
IF X1(2)=""
IF X1(3)=""
IF X1(4)=""
QUIT
+1 SET $PIECE(Y(0),U,1)=X1(1)
+2 SET $PIECE(Y(0),U,9)=X1(2)
+3 SET DVBCN=X1(3)
+4 SET DVBSN=X1(4)
+5 ;
PASS XECUTE ^%ZOSF("EOFF")
READ !,"Enter HINQ PASSWORD: ",DVBP:DTIME
XECUTE ^%ZOSF("EON")
if '$TEST
SET DVBP="^"
if '$TEST!("^."[DVBP)
QUIT
SET X=DVBP
XECUTE ^DD("FUNC",13,1)
SET DVBP=X
IF DVBP'?4E
WRITE !,*7,"Please enter 4 characters."
GOTO PASS
+1 ;VBA has changed the format of the HINQ password to allow numbers and
+2 ;special characters - DVB*4*55,ERC
+3 ;
BYPASS SET DFN="XXXZ"
+1 NEW I,I1,I2,I3,I4,I5
+2 IF '$DATA(Y(0))
SET Y=-1
QUIT
+3 SET DVBNAM=$PIECE(Y(0),"^",1)
SET I=$PIECE(DVBNAM,",")
SET I2=$PIECE(DVBNAM,",",2)
+4 FOR J=$LENGTH(I):-1:0
if $EXTRACT(I,J)?1A
QUIT
SET I=$EXTRACT(I,1,J-1)
+5 FOR J=1:1
if $FIND(I," ")=0
QUIT
SET K=$FIND(I," ")
SET I4=$EXTRACT(I,K,99)
SET I=$EXTRACT(I,1,K-2)
+6 IF $DATA(I4)
IF $LENGTH(I4)<4
SET I5=""
+7 IF '$TEST
IF $DATA(I4)
IF $LENGTH(I4)>3
IF "SRJRIII"[$PIECE(I4," ",2)
if "SRJRIII"'[$PIECE(I4," ")
SET I5=$PIECE(I4," ")
SET I4=$PIECE(I4," ",2)
+8 IF $DATA(I4)
IF I4=" "
KILL I4
+9 IF $DATA(I4)
FOR J=$LENGTH(I4):-1:0
if $EXTRACT(I4,J)'=" "
QUIT
SET I4=$EXTRACT(I4,1,J-1)
+10 IF '$DATA(I5)
IF $DATA(I4)
SET I5=I4
KILL I4
+11 FOR J=0:0
if $EXTRACT(I2)'=" "
QUIT
SET I2=$EXTRACT(I2,2,99)
+12 FOR J=$LENGTH(I2):-1:0
if $EXTRACT(I2,J)'=" "
QUIT
SET I2=$EXTRACT(I2,1,J-1)
+13 IF I2[" "
SET I3=$PIECE(I2," ",2,99)
SET I2=$PIECE(I2," ")
FOR J=0:0
if $EXTRACT(I3)'=" "
QUIT
SET I3=$EXTRACT(I3,2,99)
+14 IF '$DATA(I4)
IF $DATA(I3)
SET I4=$PIECE(I3," ",2)
SET I3=$PIECE(I3," ",1)
+15 SET DVBNAM=I_$SELECT($DATA(I5):I5,1:"")_","_I2_$SELECT($DATA(I3):","_I3,1:"")_$SELECT($DATA(I4):","_I4,1:"")
+16 IF DVBNAM["'"
SET DVBNAM=$PIECE(DVBNAM,"'")_$PIECE(DVBNAM,"'",2)
+17 IF DVBNAM["."
SET DVBNAM=$PIECE(DVBNAM,".")_$PIECE(DVBNAM,".",2)
+18 IF DVBNAM["("
SET DVBNAM=$PIECE(DVBNAM,"(")
+19 IF DVBNAM?1","
SET DVBNAM=""
+20 if DVBNAM]""
SET DVBNAM="NM"_$EXTRACT(DVBNAM,1,30)_"/"
+21 IF $DATA(^DVB(395,1,0))
SET DVBSTN=$PIECE(^DVB(395,1,0),U,2)
if 'DVBSTN
QUIT
+22 IF '$TEST
WRITE !,*7,"Station number not defined in HINQ Parameters file."
QUIT
ST ;;;CHANGED P TO E FOR TESTING NEW STRING
+1 SET DVBZ="HINQ"_DVBSTN_" "_"E"_$SELECT($PIECE(Y(0),"^",9)]""&($PIECE(Y(0),"^",9)'["P"):"SS"_$PIECE(Y(0),"^",9),1:"")_DVBNAM
CN SET I=DVBCN
if I=""
GOTO SN
FOR J=1:1
if $LENGTH(I)'<8
QUIT
SET I=0_I
+1 if $LENGTH(I)=8
SET I=" "_I
SET DVBZ=DVBZ_"CN"_I
SN SET I=DVBSN
if I=""
GOTO VDI
FOR J=1:1
if $LENGTH(I)'<8
QUIT
SET I=0_I
+1 if $LENGTH(I)=8
SET I=" "_I
SET DVBZ=DVBZ_"SN"_I
+2 ;
VDI SET DVBZ=DVBZ_DVBNUM_DVBP
SET DVBZ=$EXTRACT(DVBZ,1,9)_" "_$EXTRACT(DVBZ,10,999)
+1 ;
+2 SET Y=0
KILL %Y,I,I1,I2,I3,I4,I5,DVBNAM,DVBSTN,DVBTGT,Y(0)
QUIT
+3 ;
HELP WRITE " ",$PIECE($TEXT(HELP+H),";;",2)
KILL H
QUIT
+1 ;;Enter last name,first name up to 30 characters
+2 ;;At the last prompt ' OK ? YES// ' you may enter No to edit
+3 ;;Enter 9 digits only
+4 ;;Bad SSN
+5 ;;Enter 1-9 digits or SS for Social Security
+6 ;;Bad Claim #
+7 ;;Enter 4-9 digits or SS for Social Security
+8 ;;Bad Service #
+9 ;;Enter No to edit data Return to continue
+10 ;;Identifying Number must be 1 - 9 digits
