- 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 Feb 18, 2025@23:24:59 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
