- DVBHT1 ;ISC-ALBANY/PKE/PHH - HINQ alert parser ; 3/23/06 8:04am
- ;;4.0;HINQ;**12,15,20,43,49,57**;03/25/92
- ;
- ; cn foldloc sc diag comb% chk a&a hb pension disablity
- ; .313,.312/.314,.3731/2.05,.302,.36295,.36205,.36215,.36235,.3025
- Q
- ;S DVBDATAT(+Y)="",DVBDATA=DVBDATA_"^"_Y
- MSG S DVBDATA(+Y)="",DVBDATA=$S($L(DVBDATA)>100:DVBDATA,$P(DVBDATA,"^",16):DVBDATA,1:DVBDATA_"^"_Y) Q
- ;
- ;check on return from HINQUP processing
- ACHK S DVBNOALR=""
- ;called from batch or direct
- EN Q:'$D(DFN) Q:'DFN
- N X,Y,I,M,N,P
- S DVBDATA="^^^^^^^^^"
- EDT ; DX,DIQ,AA,ENTIT,COMB,CN,FOLD,CHECK
- ;
- D DX,DIQ,AA,ENTIT,COMB,CN,FOLD,CHECK
- I DVBDATA'="^^^^^^^^^" DO
- .I '$D(DVBNOALR) D ALERT^DVBHT Q
- .S (I,Y)=0 F S Y=$O(DVBDATA(Y)) Q:'Y DO
- ..S $P(DVBDATA,"^",I+1)=Y,I=I+1
- .K DVBNOALR
- K DVBENT,DVBSCONN
- Q
- ;
- DX Q:'$D(DVBDX) Q:'$D(DVBDXNO)
- S (DVBDXNO,I)=0 F S I=$O(DVBDX(I)) Q:I="" S DVBDXNO=DVBDXNO+1
- K M F I=1:1:DVBDXNO D
- .S M(I)=$P(DVBDX(I),U,2,3)
- .I M(I)["X0" S $P(M(I),U,2)="100"
- .S $P(M(I),U,2)=+$P(M(I),U,2)
- .S $P(M(I),U,3)=1
- .I $P(DVBDX(I),U,4)]"" S $P(M(I),U,4)=$P(DVBDX(I),U,4)
- .I $P(DVBDX(I),U,5)]"" S $P(M(I),U,5)=$$HL7TFM^XLFDT($E($P(DVBDX(I),U,5),5,8)_$E($P(DVBDX(I),U,5),1,4))
- .I $P(DVBDX(I),U,6)]"" S $P(M(I),U,6)=$$HL7TFM^XLFDT($E($P(DVBDX(I),U,6),5,8)_$E($P(DVBDX(I),U,6),1,4))
- .I '$D(DVBSCONN) S DVBSCONN=$P(M(I),"^",2) Q
- .I DVBSCONN<$P(M(I),U,2) S DVBSCONN=$P(M(I),U,2)
- S (N,P)=0
- F S N=$O(^DPT(DFN,.372,N)) Q:'N I $D(^(N,0)) DO
- .S M=0
- .F S M=$O(M(M)) Q:'M I M(M)=^(0) K M(M) Q ;tag dx+6
- .I M Q ;sc match
- .I $P(^(0),U,3) S P=P+1 ; tag dx+6,naked ref to ^dpt(dfn,.372,n,0)
- I P S Y="3-SC Disabilities" D VER
- I $D(M)>9 S Y="3+SC Disabilities" D VER
- K I,M,N,P Q
- ;
- VER ;with DVB*4*49 no BIRLS only records & Dx, Verified not sent
- D MSG Q
- ;
- DIQ ;K DVBDIQ(2)
- F LP2=.361,.302,.3025,.312,.313,.314,.36205,.36215,.36235,.36295 S X="DVBDIQ(2,"_DFN_","_LP2_")" K @X
- S DR=".302;.3025;.312;.313;.314;.361;.36205;.36215;.36235;.36295"
- DIQDR S DIC="^DPT(",DA=DFN,DIQ(0)="E",DIQ="DVBDIQ(" D EN^DIQ1 Q
- ;
- ; I V=0 HBa/oA&A term V=1 Hospitlize pay HB, A&A entitled
- ; I V=2 A&A V=3 HB V=" " HB a/o A&A not granted
- AA I $D(DVBAAHB) S V1=DVBAAHB S V=V1 S:V1>3&(V1<8) V=V1-4
- I '$D(DVBAAHB) S V=9
- I $D(DVBBAS(1)),$P(DVBBAS(1),"^",6)="E" S V=0 ;terminated pending purge
- I DVBDIQ(2,DFN,.36205,"E")="YES","0 9"[V S Y="5-A&A" D MSG
- I DVBDIQ(2,DFN,.36205,"E")'="YES","12"[V S Y="5+A&A" D MSG
- ;
- I DVBDIQ(2,DFN,.36215,"E")="YES","0 9"[V S Y="5-HB" D MSG
- I DVBDIQ(2,DFN,.36215,"E")'="YES","13"[V S Y="5+HB" D MSG
- Q
- ;
- ;compensation, pension
- ENTIT S DVBENT=" " I $D(DVBP(1)) S T1=$P(DVBP(1),U,4) D
- . I T1'="" S DVBENT=$S(T1="01":"Compensation",T1="0L":"Pension",1:" ")
- S Y=0
- I DVBDIQ(2,DFN,.36235,"E")="YES" DO
- .;terminated pending purge
- .I $G(DVBCHECK)'>0,$G(DVBDXNO)>0 S DVBENT=" "
- .;all record types now "A", so had to check if no VA Check and has
- .;SC disabilities instead of checking for type "E" record - DVB*4*49
- .I DVBENT["Pension" Q
- .S Y="5-Pension"
- E I DVBENT["Pension" S Y="5+Pension"
- I Y D MSG
- ;
- S Y=0
- I DVBDIQ(2,DFN,.3025,"E")="YES" DO
- .I DVBENT["ompensation" Q
- .I DVBENT["Disability" Q
- .S Y="5-Compensation"
- E I DVBENT'=" " DO
- .I DVBENT["ompensation"!(DVBENT["Disability") S Y="5+Compensation"
- I Y D MSG
- Q
- ;DVBSCONN is biggest SC disability
- COMB I '$D(DVBSCONN) S Y=""
- E DO
- .S Y=DVBSCONN
- .I $D(DVBCAP) Q ;birls
- .I DVBENT["Pension" Q
- .S Y=$S($D(DVBDXPCT):$S(+DVBDXPCT?1N.N:+DVBDXPCT,1:DVBSCONN))
- .S DVBSCONN=Y
- I +DVBDIQ(2,DFN,.302,"E")=+Y S Y=0
- E DO
- .S Y=0
- .;c&p
- .I '$D(DVBSCONN)!(DVBENT["ompensation")!(DVBENT["Disability") DO Q
- . .S Y="5?SC Combined %"
- .;birls,pension
- .I DVBDIQ(2,DFN,.361,"E")["SERVICE CONNECTED",DVBSCONN>49 Q
- .I DVBDIQ(2,DFN,.361,"E")["SC LESS THAN",DVBSCONN<50 Q
- .S Y="5?SC Combined %"
- I Y D MSG
- K DVBALERT,DVBSCONN
- Q
- ;
- CN I +DVBDIQ(2,DFN,.313,"E")=$S($D(DVBCN):+DVBCN,1:0)
- E S Y="2?Claim #" D MSG
- Q
- ; --check in xman
- FOLD Q:'$D(DVBFL) S Y=0
- I $G(DVBFL)=" " S DVBFL=""
- I '$D(DVBDIQ(2,DFN,.314,"E")) DO
- .I +DVBDIQ(2,DFN,.312,"E")=$S($D(DVBFL):+DVBFL,1:0) Q
- .S Y="2?Folder Location"
- E DO ;pims v5.3 y => abc_ro, 323, or ""
- .S Y=$S($D(DVBFL):$S($P(DVBFL,"- ",2)]"":$P(DVBFL,"- ",2),1:DVBFL),1:"")
- .I DVBDIQ(2,DFN,.314,"E")=Y Q
- .S Y="2?Folder Location"
- I Y D MSG
- Q
- ;
- CHECK S Y=0
- I $D(DVBDIQ(2,DFN,.36295,"E")) DO ;pims v5.3
- .I $D(DVBBAS(1)),$L($P(DVBBAS(1),"^",20)) S Y=$P(DVBBAS(1),"^",20)
- .I +DVBDIQ(2,DFN,.36295,"E")=+$S(Y:Y*12,$D(DVBCHECK):DVBCHECK*12,1:"") S Y=0 Q
- .S Y="5?VA Check/Net Award"
- I Y D MSG
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBHT1 4693 printed Jan 18, 2025@03:00:25 Page 2
- DVBHT1 ;ISC-ALBANY/PKE/PHH - HINQ alert parser ; 3/23/06 8:04am
- +1 ;;4.0;HINQ;**12,15,20,43,49,57**;03/25/92
- +2 ;
- +3 ; cn foldloc sc diag comb% chk a&a hb pension disablity
- +4 ; .313,.312/.314,.3731/2.05,.302,.36295,.36205,.36215,.36235,.3025
- +5 QUIT
- +6 ;S DVBDATAT(+Y)="",DVBDATA=DVBDATA_"^"_Y
- MSG SET DVBDATA(+Y)=""
- SET DVBDATA=$SELECT($LENGTH(DVBDATA)>100:DVBDATA,$PIECE(DVBDATA,"^",16):DVBDATA,1:DVBDATA_"^"_Y)
- QUIT
- +1 ;
- +2 ;check on return from HINQUP processing
- ACHK SET DVBNOALR=""
- +1 ;called from batch or direct
- EN if '$DATA(DFN)
- QUIT
- if 'DFN
- QUIT
- +1 NEW X,Y,I,M,N,P
- +2 SET DVBDATA="^^^^^^^^^"
- EDT ; DX,DIQ,AA,ENTIT,COMB,CN,FOLD,CHECK
- +1 ;
- +2 DO DX
- DO DIQ
- DO AA
- DO ENTIT
- DO COMB
- DO CN
- DO FOLD
- DO CHECK
- +3 IF DVBDATA'="^^^^^^^^^"
- Begin DoDot:1
- +4 IF '$DATA(DVBNOALR)
- DO ALERT^DVBHT
- QUIT
- +5 SET (I,Y)=0
- FOR
- SET Y=$ORDER(DVBDATA(Y))
- if 'Y
- QUIT
- Begin DoDot:2
- +6 SET $PIECE(DVBDATA,"^",I+1)=Y
- SET I=I+1
- End DoDot:2
- +7 KILL DVBNOALR
- End DoDot:1
- +8 KILL DVBENT,DVBSCONN
- +9 QUIT
- +10 ;
- DX if '$DATA(DVBDX)
- QUIT
- if '$DATA(DVBDXNO)
- QUIT
- +1 SET (DVBDXNO,I)=0
- FOR
- SET I=$ORDER(DVBDX(I))
- if I=""
- QUIT
- SET DVBDXNO=DVBDXNO+1
- +2 KILL M
- FOR I=1:1:DVBDXNO
- Begin DoDot:1
- +3 SET M(I)=$PIECE(DVBDX(I),U,2,3)
- +4 IF M(I)["X0"
- SET $PIECE(M(I),U,2)="100"
- +5 SET $PIECE(M(I),U,2)=+$PIECE(M(I),U,2)
- +6 SET $PIECE(M(I),U,3)=1
- +7 IF $PIECE(DVBDX(I),U,4)]""
- SET $PIECE(M(I),U,4)=$PIECE(DVBDX(I),U,4)
- +8 IF $PIECE(DVBDX(I),U,5)]""
- SET $PIECE(M(I),U,5)=$$HL7TFM^XLFDT($EXTRACT($PIECE(DVBDX(I),U,5),5,8)_$EXTRACT($PIECE(DVBDX(I),U,5),1,4))
- +9 IF $PIECE(DVBDX(I),U,6)]""
- SET $PIECE(M(I),U,6)=$$HL7TFM^XLFDT($EXTRACT($PIECE(DVBDX(I),U,6),5,8)_$EXTRACT($PIECE(DVBDX(I),U,6),1,4))
- +10 IF '$DATA(DVBSCONN)
- SET DVBSCONN=$PIECE(M(I),"^",2)
- QUIT
- +11 IF DVBSCONN<$PIECE(M(I),U,2)
- SET DVBSCONN=$PIECE(M(I),U,2)
- End DoDot:1
- +12 SET (N,P)=0
- +13 FOR
- SET N=$ORDER(^DPT(DFN,.372,N))
- if 'N
- QUIT
- IF $DATA(^(N,0))
- Begin DoDot:1
- +14 SET M=0
- +15 ;tag dx+6
- FOR
- SET M=$ORDER(M(M))
- if 'M
- QUIT
- IF M(M)=^(0)
- KILL M(M)
- QUIT
- +16 ;sc match
- IF M
- QUIT
- +17 ; tag dx+6,naked ref to ^dpt(dfn,.372,n,0)
- IF $PIECE(^(0),U,3)
- SET P=P+1
- End DoDot:1
- +18 IF P
- SET Y="3-SC Disabilities"
- DO VER
- +19 IF $DATA(M)>9
- SET Y="3+SC Disabilities"
- DO VER
- +20 KILL I,M,N,P
- QUIT
- +21 ;
- VER ;with DVB*4*49 no BIRLS only records & Dx, Verified not sent
- +1 DO MSG
- QUIT
- +2 ;
- DIQ ;K DVBDIQ(2)
- +1 FOR LP2=.361,.302,.3025,.312,.313,.314,.36205,.36215,.36235,.36295
- SET X="DVBDIQ(2,"_DFN_","_LP2_")"
- KILL @X
- +2 SET DR=".302;.3025;.312;.313;.314;.361;.36205;.36215;.36235;.36295"
- DIQDR SET DIC="^DPT("
- SET DA=DFN
- SET DIQ(0)="E"
- SET DIQ="DVBDIQ("
- DO EN^DIQ1
- QUIT
- +1 ;
- +2 ; I V=0 HBa/oA&A term V=1 Hospitlize pay HB, A&A entitled
- +3 ; I V=2 A&A V=3 HB V=" " HB a/o A&A not granted
- AA IF $DATA(DVBAAHB)
- SET V1=DVBAAHB
- SET V=V1
- if V1>3&(V1<8)
- SET V=V1-4
- +1 IF '$DATA(DVBAAHB)
- SET V=9
- +2 ;terminated pending purge
- IF $DATA(DVBBAS(1))
- IF $PIECE(DVBBAS(1),"^",6)="E"
- SET V=0
- +3 IF DVBDIQ(2,DFN,.36205,"E")="YES"
- IF "0 9"[V
- SET Y="5-A&A"
- DO MSG
- +4 IF DVBDIQ(2,DFN,.36205,"E")'="YES"
- IF "12"[V
- SET Y="5+A&A"
- DO MSG
- +5 ;
- +6 IF DVBDIQ(2,DFN,.36215,"E")="YES"
- IF "0 9"[V
- SET Y="5-HB"
- DO MSG
- +7 IF DVBDIQ(2,DFN,.36215,"E")'="YES"
- IF "13"[V
- SET Y="5+HB"
- DO MSG
- +8 QUIT
- +9 ;
- +10 ;compensation, pension
- ENTIT SET DVBENT=" "
- IF $DATA(DVBP(1))
- SET T1=$PIECE(DVBP(1),U,4)
- Begin DoDot:1
- +1 IF T1'=""
- SET DVBENT=$SELECT(T1="01":"Compensation",T1="0L":"Pension",1:" ")
- End DoDot:1
- +2 SET Y=0
- +3 IF DVBDIQ(2,DFN,.36235,"E")="YES"
- Begin DoDot:1
- +4 ;terminated pending purge
- +5 IF $GET(DVBCHECK)'>0
- IF $GET(DVBDXNO)>0
- SET DVBENT=" "
- +6 ;all record types now "A", so had to check if no VA Check and has
- +7 ;SC disabilities instead of checking for type "E" record - DVB*4*49
- +8 IF DVBENT["Pension"
- QUIT
- +9 SET Y="5-Pension"
- End DoDot:1
- +10 IF '$TEST
- IF DVBENT["Pension"
- SET Y="5+Pension"
- +11 IF Y
- DO MSG
- +12 ;
- +13 SET Y=0
- +14 IF DVBDIQ(2,DFN,.3025,"E")="YES"
- Begin DoDot:1
- +15 IF DVBENT["ompensation"
- QUIT
- +16 IF DVBENT["Disability"
- QUIT
- +17 SET Y="5-Compensation"
- End DoDot:1
- +18 IF '$TEST
- IF DVBENT'=" "
- Begin DoDot:1
- +19 IF DVBENT["ompensation"!(DVBENT["Disability")
- SET Y="5+Compensation"
- End DoDot:1
- +20 IF Y
- DO MSG
- +21 QUIT
- +22 ;DVBSCONN is biggest SC disability
- COMB IF '$DATA(DVBSCONN)
- SET Y=""
- +1 IF '$TEST
- Begin DoDot:1
- +2 SET Y=DVBSCONN
- +3 ;birls
- IF $DATA(DVBCAP)
- QUIT
- +4 IF DVBENT["Pension"
- QUIT
- +5 SET Y=$SELECT($DATA(DVBDXPCT):$SELECT(+DVBDXPCT?1N.N:+DVBDXPCT,1:DVBSCONN))
- +6 SET DVBSCONN=Y
- End DoDot:1
- +7 IF +DVBDIQ(2,DFN,.302,"E")=+Y
- SET Y=0
- +8 IF '$TEST
- Begin DoDot:1
- +9 SET Y=0
- +10 ;c&p
- +11 IF '$DATA(DVBSCONN)!(DVBENT["ompensation")!(DVBENT["Disability")
- Begin DoDot:2
- +12 SET Y="5?SC Combined %"
- End DoDot:2
- QUIT
- +13 ;birls,pension
- +14 IF DVBDIQ(2,DFN,.361,"E")["SERVICE CONNECTED"
- IF DVBSCONN>49
- QUIT
- +15 IF DVBDIQ(2,DFN,.361,"E")["SC LESS THAN"
- IF DVBSCONN<50
- QUIT
- +16 SET Y="5?SC Combined %"
- End DoDot:1
- +17 IF Y
- DO MSG
- +18 KILL DVBALERT,DVBSCONN
- +19 QUIT
- +20 ;
- CN IF +DVBDIQ(2,DFN,.313,"E")=$SELECT($DATA(DVBCN):+DVBCN,1:0)
- +1 IF '$TEST
- SET Y="2?Claim #"
- DO MSG
- +2 QUIT
- +3 ; --check in xman
- FOLD if '$DATA(DVBFL)
- QUIT
- SET Y=0
- +1 IF $GET(DVBFL)=" "
- SET DVBFL=""
- +2 IF '$DATA(DVBDIQ(2,DFN,.314,"E"))
- Begin DoDot:1
- +3 IF +DVBDIQ(2,DFN,.312,"E")=$SELECT($DATA(DVBFL):+DVBFL,1:0)
- QUIT
- +4 SET Y="2?Folder Location"
- End DoDot:1
- +5 ;pims v5.3 y => abc_ro, 323, or ""
- IF '$TEST
- Begin DoDot:1
- +6 SET Y=$SELECT($DATA(DVBFL):$SELECT($PIECE(DVBFL,"- ",2)]"":$PIECE(DVBFL,"- ",2),1:DVBFL),1:"")
- +7 IF DVBDIQ(2,DFN,.314,"E")=Y
- QUIT
- +8 SET Y="2?Folder Location"
- End DoDot:1
- +9 IF Y
- DO MSG
- +10 QUIT
- +11 ;
- CHECK SET Y=0
- +1 ;pims v5.3
- IF $DATA(DVBDIQ(2,DFN,.36295,"E"))
- Begin DoDot:1
- +2 IF $DATA(DVBBAS(1))
- IF $LENGTH($PIECE(DVBBAS(1),"^",20))
- SET Y=$PIECE(DVBBAS(1),"^",20)
- +3 IF +DVBDIQ(2,DFN,.36295,"E")=+$SELECT(Y:Y*12,$DATA(DVBCHECK):DVBCHECK*12,1:"")
- SET Y=0
- QUIT
- +4 SET Y="5?VA Check/Net Award"
- End DoDot:1
- +5 IF Y
- DO MSG
- +6 QUIT