IBACCWLVS ;EDE/TAZ - ACC (Automated Community Care) Encounters - Action Item related to Service Connection and Special Authority ; 12-SEP-2023
;;2.0;INTEGRATED BILLING;**770**;;Build 119
;;Per VA Directive 6402, this routine should not be modified.
;
; Reference to ^DGENA in ICR #3812
Q
;
;;TAZ*IB*2*770v24;Update code to match ICRs
EN(DFN) ;EP - CALLED BY IBACCWLAIVIEW
; Input -- DFN Patient IEN
; Output -- None
;
;;TAZ*IB*2*770v20;Added VALMSG so bar shows default message.
N VALMBG,VALMCNT,VALMHDR,VALMSG
K ^TMP("IBACCWLVS",$J)
D WAIT^DICD
D EN^VALM("IBACC WL VS")
Q
;
HDR ;Header code
N VA
D PID^VADPT
S VALMHDR(1)=$E("Patient: "_$P($G(^DPT(DFN,0)),U),1,30)_" ("_VA("BID")_")"
Q
;
INIT ;Init variables and list array
D CLEAN^VALM10
K ^TMP("IBACCWLVS",$J)
S VALMBG=1,VALMCNT=0
;
D BLD
Q
;
BLD ;Build service connected/special a screen
N CCNT,CTR,DATA,IBELIG,IBENR,IBRESLT,IENS,LINEVAR,SCCONDS,STR,VSARRAY
N SORTED ; WCJ;V38;EBILL-5407
S IENS=DFN_","
;
D CL^IBACV(DFN,,,.IBRESLT) ;SC/SA data
D INS(DFN,.INS) ;Insurance Related data
S IBELIG=$$FINDCUR^DGENA(DFN) ;ICR #3812 (Controlled)
I $$GET^DGENA(IBELIG,.IBENR) ;ICR #3812 (Controlled)
;
; D GETS^DIQ(2,IENS,".3731*","E","VSARRAY","VSERROR") ; WCJ;V38;EBILL-5407
D GETS^DIQ(2,IENS,".3721*","IE","VSARRAY","VSERROR") ; WCJ;V38;EBILL-5407
D SORTED(.VSARRAY,.SORTED) ; WCJ;V38;EBILL-5407
;
S LINEVAR=""
;I IBRESLT(3) - "SERVICE CONNECTED" ;$$SC^SDCO22(dfn,"")
S DATA=$S($D(IBRESLT(3)):"YES",1:"NA")
S LINEVAR=$$SETFLD^VALM1("Service Connected",LINEVAR,"LCAP"),LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"LDATA")
S LINEVAR=$$SETFLD^VALM1("SC Percentage",LINEVAR,"RCAP"),LINEVAR=$$SETFLD^VALM1(+$G(IBENR("ELIG","SCPER")),LINEVAR,"RDATA")
S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,LINEVAR)
;
I '$D(SORTED(0)) D
. S DATA="Rated Disabilities"
. S LINEVAR="",LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"LCAP")
. S LINEVAR=$$SETFLD^VALM1("NONE",LINEVAR,"LDATA") ;WCJ;V38;EBILL-5407
. S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,LINEVAR)
;I '$D(VSARRAY(2.05)) S LINEVAR=$$SETFLD^VALM1("NONE",LINEVAR,"LDATA") ;WCJ;V38;EBILL-5407
I $D(SORTED(0)) D
. S LINEVAR="",LINEVAR=$$SETFLD^VALM1(SORTED(0),LINEVAR,"TABLEHDR")
. S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,LINEVAR)
. ;F CCNT=1:1 S CTR=CCNT_","_DFN_"," Q:'$D(VSARRAY(2.05,CTR)) D ;WCJ;V38;EBILL-5407
. F CCNT=1:1 Q:'$D(SORTED(CCNT)) D ;WCJ;V38;EBILL-5407
.. S LINEVAR=""
..; S DATA=VSARRAY(2.05,CTR,.01,"E")_" ("_VSARRAY(2.05,CTR,.02,"E")_")" ;WCJ;V38;EBILL-5407
.. S DATA=SORTED(CCNT) ;WCJ;V38;EBILL-5407
.. S LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"COND")
.. S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,LINEVAR)
;
S LINEVAR=""
;I IBRESLT(7) - "COMBAT VETERAN" ;$$CV^SDCO22(dfn,"","")
S DATA=$S($D(IBRESLT(7)):"YES",1:"NA")
S LINEVAR=$$SETFLD^VALM1("Combat Vet Elig Indicator",LINEVAR,"LCAP"),LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"LDATA")
S DATA=$S($G(IBENR("ELIG","CVELEDT"))'="":$$FMTE^XLFDT(IBENR("ELIG","CVELEDT")),1:"")
S LINEVAR=$$SETFLD^VALM1("Combat Vet End Date",LINEVAR,"RCAP"),LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"RDATA")
S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,LINEVAR)
;
S LINEVAR=""
;I IBRESLT(1) - "AGENT ORANGE" ;$$AO^SDCO22(dfn,"")
S DATA=$S($D(IBRESLT(1)):"YES",1:"NO")
S LINEVAR=$$SETFLD^VALM1("Agent Orange Exposure Ind",LINEVAR,"LCAP"),LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"LDATA")
;I IBRESLT(4) - "SW ASIA CONDITIONS" ;$$EC^SDCO22(dfn,"")
S DATA=$S($D(IBRESLT(4)):"YES",1:"NO")
S LINEVAR=$$SETFLD^VALM1("Southwest Asia",LINEVAR,"RCAP"),LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"RDATA")
S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,LINEVAR)
;
S LINEVAR=""
;I IBRESLT(2) - "IONIZING RADIATION" ;$$IR^SDCO22(dfn,"")
S DATA=$S($D(IBRESLT(2)):"YES",1:"NO")
S LINEVAR=$$SETFLD^VALM1("Ionizing Radiation",LINEVAR,"LCAP"),LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"LDATA")
;I IBRESLT(6) - "HEAD AND/OR NECK" ;$$HNC^SDCO22(dfn,"")
S DATA=$S($D(IBRESLT(6)):"YES",1:"NO")
S LINEVAR=$$SETFLD^VALM1("Head and/or Neck",LINEVAR,"RCAP"),LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"RDATA")
S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,LINEVAR)
;
S LINEVAR=""
S DATA=$S($D(INS("IVF")):"YES",1:"NO")
S LINEVAR=$$SETFLD^VALM1("In Vitro Fertilization",LINEVAR,"LCAP"),LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"LDATA")
S DATA=$S($G(IBENR("ELIG","CLE"))'="":"YES",1:"NO")
S LINEVAR=$$SETFLD^VALM1("Camp LeJeune",LINEVAR,"RCAP"),LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"RDATA")
S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,LINEVAR)
;
S LINEVAR=""
;I IBRESLT(8) - "PROJ 112/SHAD" ;$$SHAD^SDCO22(dfn)
S DATA=$S($D(IBRESLT(8)):"YES",1:"NO")
S LINEVAR=$$SETFLD^VALM1("Project 112/SHAD",LINEVAR,"LCAP"),LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"LDATA")
;I IBRESLT(5) - "MILITARY SEXUAL TRAUMA" ;$$MST^SDCO22(dfn,"")
S DATA=$S($D(IBRESLT(5)):"YES",1:"NO")
S LINEVAR=$$SETFLD^VALM1("MST",LINEVAR,"RCAP"),LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"RDATA")
S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,LINEVAR)
;
S LINEVAR=""
S DATA=$S($D(INS("RC")):"YES",1:"NO")
S LINEVAR=$$SETFLD^VALM1("Office of Regional Council",LINEVAR,"LCAP"),LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"LDATA")
S DATA=$S($D(INS("DOL")):"YES",1:"NO")
S LINEVAR=$$SETFLD^VALM1("Dept of Labor",LINEVAR,"RCAP"),LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"RDATA")
S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,LINEVAR)
;
S LINEVAR=""
S DATA=$S($G(IBENR("PRIORITY"))'="":$G(IBENR("PRIORITY")),1:"NONE")
S LINEVAR=$$SETFLD^VALM1("Priority Group",LINEVAR,"LCAP"),LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"LDATA")
I DATA'="NONE" D
. S DATA="" I $G(IBENR("EFFDATE")) S DATA=$$FMTE^XLFDT(IBENR("EFFDATE"))
. S LINEVAR=$$SETFLD^VALM1("Effective Date",LINEVAR,"RCAP"),LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"RDATA")
S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,LINEVAR)
;
BLDQ ;
Q
;
BLNKLN ; Set blank line
S LINEVAR=""
S LINEVAR=$$SETFLD^VALM1("",LINEVAR,"LCAP")
S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,LINEVAR)
Q
;
INS(DFN,INS) ; Check if patient has IVF insurance
N IBDOS,IBINS,INSCONM,INSCONUM,INSIEN,IVF
S IBDOS=DT I $G(IBENCIFN) S IBDOS=$$GET1^DIQ(364.9,IBENCIFN,.12,"I") ;Date of Service
D ALL^IBCNS1(DFN,"IBINS",1,IBDOS,1)
S (INSIEN,IVF)=0
F S INSIEN=$O(IBINS(INSIEN)) Q:'INSIEN D
. S INSCONUM=$P(IBINS(INSIEN,0),U)
. S INSCONM=$$GET1^DIQ(36,INSCONUM_",",.01,"E")
. I INSCONM["IVF" S INS("IVF")="" Q
. I INSCONM["REGIONAL COUNCIL" S INS("RC")="" Q
. I INSCONM["DEPT OF LABOR" S INS("DOL")=""
Q
;
HELP ;Help code
N X
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ;Exit code
D CLEAN^VALM10
D CLEAR^VALM1
K ^TMP("IBACCWLVS",$J)
Q
;
EXPND ;Expand code
Q
;
SORTED(VSARRAY,RETURN) ; sorted rated disabilites like they do in registration screens
;
N S1,S2
N SORTED
;
S S1=2.04
Q:'$D(VSARRAY(S1))
;
S S2=""
F S S2=$O(VSARRAY(S1,S2)) Q:S2="" D
. N DR
. S DR=$G(VSARRAY(S1,S2,2,"I")) ; disability rating (%)
. S SORTED(+DR,S2)=""
;
N CNT,BLANK,SF
S SF=2.04
S CNT=0,BLANK=" "
S S1="A" F S S1=$O(SORTED(S1),-1) Q:S1="" D ;get hightest % first
.S S2="" F S S2=$O(SORTED(S1,S2)) Q:S2="" D
.. S CNT=CNT+1
.. N D1,D2,D3,D4,D5,D6,D7
.. N DATA1,DATA2
.. S D1="" I $D(VSARRAY(SF,S2,.01,"I")) S D1=$$GET1^DIQ(31,VSARRAY(SF,S2,.01,"I"),2)
.. S D2=$E($G(VSARRAY(SF,S2,.01,"E")),1,36)
.. S D3=$G(VSARRAY(SF,S2,2,"I"))
.. S D4=$G(VSARRAY(SF,S2,3,"I"))
.. S DATA=D1_"-"_D2_"("_D3_"%"_$S(+D4:" SC",1:"")_")"
.. S D5=$G(VSARRAY(SF,S2,4,"I"))
.. S D6=$G(VSARRAY(SF,S2,5,"E"))
.. S D7=$G(VSARRAY(SF,S2,6,"E"))
.. S RETURN(CNT)=$E(DATA_BLANK,1,49)_" "_$E(D5_BLANK,1,2)_" "_$E(D6_BLANK,1,12)_" "_$E(D7_BLANK,1,12)
I CNT>0 S RETURN(0)="Rated Disability EA Orig Eff Dt Curr Eff Dt"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBACCWLVS 7906 printed May 25, 2026@12:10:25 Page 2
IBACCWLVS ;EDE/TAZ - ACC (Automated Community Care) Encounters - Action Item related to Service Connection and Special Authority ; 12-SEP-2023
+1 ;;2.0;INTEGRATED BILLING;**770**;;Build 119
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Reference to ^DGENA in ICR #3812
+5 QUIT
+6 ;
+7 ;;TAZ*IB*2*770v24;Update code to match ICRs
EN(DFN) ;EP - CALLED BY IBACCWLAIVIEW
+1 ; Input -- DFN Patient IEN
+2 ; Output -- None
+3 ;
+4 ;;TAZ*IB*2*770v20;Added VALMSG so bar shows default message.
+5 NEW VALMBG,VALMCNT,VALMHDR,VALMSG
+6 KILL ^TMP("IBACCWLVS",$JOB)
+7 DO WAIT^DICD
+8 DO EN^VALM("IBACC WL VS")
+9 QUIT
+10 ;
HDR ;Header code
+1 NEW VA
+2 DO PID^VADPT
+3 SET VALMHDR(1)=$EXTRACT("Patient: "_$PIECE($GET(^DPT(DFN,0)),U),1,30)_" ("_VA("BID")_")"
+4 QUIT
+5 ;
INIT ;Init variables and list array
+1 DO CLEAN^VALM10
+2 KILL ^TMP("IBACCWLVS",$JOB)
+3 SET VALMBG=1
SET VALMCNT=0
+4 ;
+5 DO BLD
+6 QUIT
+7 ;
BLD ;Build service connected/special a screen
+1 NEW CCNT,CTR,DATA,IBELIG,IBENR,IBRESLT,IENS,LINEVAR,SCCONDS,STR,VSARRAY
+2 ; WCJ;V38;EBILL-5407
NEW SORTED
+3 SET IENS=DFN_","
+4 ;
+5 ;SC/SA data
DO CL^IBACV(DFN,,,.IBRESLT)
+6 ;Insurance Related data
DO INS(DFN,.INS)
+7 ;ICR #3812 (Controlled)
SET IBELIG=$$FINDCUR^DGENA(DFN)
+8 ;ICR #3812 (Controlled)
IF $$GET^DGENA(IBELIG,.IBENR)
+9 ;
+10 ; D GETS^DIQ(2,IENS,".3731*","E","VSARRAY","VSERROR") ; WCJ;V38;EBILL-5407
+11 ; WCJ;V38;EBILL-5407
DO GETS^DIQ(2,IENS,".3721*","IE","VSARRAY","VSERROR")
+12 ; WCJ;V38;EBILL-5407
DO SORTED(.VSARRAY,.SORTED)
+13 ;
+14 SET LINEVAR=""
+15 ;I IBRESLT(3) - "SERVICE CONNECTED" ;$$SC^SDCO22(dfn,"")
+16 SET DATA=$SELECT($DATA(IBRESLT(3)):"YES",1:"NA")
+17 SET LINEVAR=$$SETFLD^VALM1("Service Connected",LINEVAR,"LCAP")
SET LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"LDATA")
+18 SET LINEVAR=$$SETFLD^VALM1("SC Percentage",LINEVAR,"RCAP")
SET LINEVAR=$$SETFLD^VALM1(+$GET(IBENR("ELIG","SCPER")),LINEVAR,"RDATA")
+19 SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT,LINEVAR)
+20 ;
+21 IF '$DATA(SORTED(0))
Begin DoDot:1
+22 SET DATA="Rated Disabilities"
+23 SET LINEVAR=""
SET LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"LCAP")
+24 ;WCJ;V38;EBILL-5407
SET LINEVAR=$$SETFLD^VALM1("NONE",LINEVAR,"LDATA")
+25 SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT,LINEVAR)
End DoDot:1
+26 ;I '$D(VSARRAY(2.05)) S LINEVAR=$$SETFLD^VALM1("NONE",LINEVAR,"LDATA") ;WCJ;V38;EBILL-5407
+27 IF $DATA(SORTED(0))
Begin DoDot:1
+28 SET LINEVAR=""
SET LINEVAR=$$SETFLD^VALM1(SORTED(0),LINEVAR,"TABLEHDR")
+29 SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT,LINEVAR)
+30 ;F CCNT=1:1 S CTR=CCNT_","_DFN_"," Q:'$D(VSARRAY(2.05,CTR)) D ;WCJ;V38;EBILL-5407
+31 ;WCJ;V38;EBILL-5407
FOR CCNT=1:1
if '$DATA(SORTED(CCNT))
QUIT
Begin DoDot:2
+32 SET LINEVAR=""
+33 ; S DATA=VSARRAY(2.05,CTR,.01,"E")_" ("_VSARRAY(2.05,CTR,.02,"E")_")" ;WCJ;V38;EBILL-5407
+34 ;WCJ;V38;EBILL-5407
SET DATA=SORTED(CCNT)
+35 SET LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"COND")
+36 SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT,LINEVAR)
End DoDot:2
End DoDot:1
+37 ;
+38 SET LINEVAR=""
+39 ;I IBRESLT(7) - "COMBAT VETERAN" ;$$CV^SDCO22(dfn,"","")
+40 SET DATA=$SELECT($DATA(IBRESLT(7)):"YES",1:"NA")
+41 SET LINEVAR=$$SETFLD^VALM1("Combat Vet Elig Indicator",LINEVAR,"LCAP")
SET LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"LDATA")
+42 SET DATA=$SELECT($GET(IBENR("ELIG","CVELEDT"))'="":$$FMTE^XLFDT(IBENR("ELIG","CVELEDT")),1:"")
+43 SET LINEVAR=$$SETFLD^VALM1("Combat Vet End Date",LINEVAR,"RCAP")
SET LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"RDATA")
+44 SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT,LINEVAR)
+45 ;
+46 SET LINEVAR=""
+47 ;I IBRESLT(1) - "AGENT ORANGE" ;$$AO^SDCO22(dfn,"")
+48 SET DATA=$SELECT($DATA(IBRESLT(1)):"YES",1:"NO")
+49 SET LINEVAR=$$SETFLD^VALM1("Agent Orange Exposure Ind",LINEVAR,"LCAP")
SET LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"LDATA")
+50 ;I IBRESLT(4) - "SW ASIA CONDITIONS" ;$$EC^SDCO22(dfn,"")
+51 SET DATA=$SELECT($DATA(IBRESLT(4)):"YES",1:"NO")
+52 SET LINEVAR=$$SETFLD^VALM1("Southwest Asia",LINEVAR,"RCAP")
SET LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"RDATA")
+53 SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT,LINEVAR)
+54 ;
+55 SET LINEVAR=""
+56 ;I IBRESLT(2) - "IONIZING RADIATION" ;$$IR^SDCO22(dfn,"")
+57 SET DATA=$SELECT($DATA(IBRESLT(2)):"YES",1:"NO")
+58 SET LINEVAR=$$SETFLD^VALM1("Ionizing Radiation",LINEVAR,"LCAP")
SET LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"LDATA")
+59 ;I IBRESLT(6) - "HEAD AND/OR NECK" ;$$HNC^SDCO22(dfn,"")
+60 SET DATA=$SELECT($DATA(IBRESLT(6)):"YES",1:"NO")
+61 SET LINEVAR=$$SETFLD^VALM1("Head and/or Neck",LINEVAR,"RCAP")
SET LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"RDATA")
+62 SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT,LINEVAR)
+63 ;
+64 SET LINEVAR=""
+65 SET DATA=$SELECT($DATA(INS("IVF")):"YES",1:"NO")
+66 SET LINEVAR=$$SETFLD^VALM1("In Vitro Fertilization",LINEVAR,"LCAP")
SET LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"LDATA")
+67 SET DATA=$SELECT($GET(IBENR("ELIG","CLE"))'="":"YES",1:"NO")
+68 SET LINEVAR=$$SETFLD^VALM1("Camp LeJeune",LINEVAR,"RCAP")
SET LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"RDATA")
+69 SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT,LINEVAR)
+70 ;
+71 SET LINEVAR=""
+72 ;I IBRESLT(8) - "PROJ 112/SHAD" ;$$SHAD^SDCO22(dfn)
+73 SET DATA=$SELECT($DATA(IBRESLT(8)):"YES",1:"NO")
+74 SET LINEVAR=$$SETFLD^VALM1("Project 112/SHAD",LINEVAR,"LCAP")
SET LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"LDATA")
+75 ;I IBRESLT(5) - "MILITARY SEXUAL TRAUMA" ;$$MST^SDCO22(dfn,"")
+76 SET DATA=$SELECT($DATA(IBRESLT(5)):"YES",1:"NO")
+77 SET LINEVAR=$$SETFLD^VALM1("MST",LINEVAR,"RCAP")
SET LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"RDATA")
+78 SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT,LINEVAR)
+79 ;
+80 SET LINEVAR=""
+81 SET DATA=$SELECT($DATA(INS("RC")):"YES",1:"NO")
+82 SET LINEVAR=$$SETFLD^VALM1("Office of Regional Council",LINEVAR,"LCAP")
SET LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"LDATA")
+83 SET DATA=$SELECT($DATA(INS("DOL")):"YES",1:"NO")
+84 SET LINEVAR=$$SETFLD^VALM1("Dept of Labor",LINEVAR,"RCAP")
SET LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"RDATA")
+85 SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT,LINEVAR)
+86 ;
+87 SET LINEVAR=""
+88 SET DATA=$SELECT($GET(IBENR("PRIORITY"))'="":$GET(IBENR("PRIORITY")),1:"NONE")
+89 SET LINEVAR=$$SETFLD^VALM1("Priority Group",LINEVAR,"LCAP")
SET LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"LDATA")
+90 IF DATA'="NONE"
Begin DoDot:1
+91 SET DATA=""
IF $GET(IBENR("EFFDATE"))
SET DATA=$$FMTE^XLFDT(IBENR("EFFDATE"))
+92 SET LINEVAR=$$SETFLD^VALM1("Effective Date",LINEVAR,"RCAP")
SET LINEVAR=$$SETFLD^VALM1(DATA,LINEVAR,"RDATA")
End DoDot:1
+93 SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT,LINEVAR)
+94 ;
BLDQ ;
+1 QUIT
+2 ;
BLNKLN ; Set blank line
+1 SET LINEVAR=""
+2 SET LINEVAR=$$SETFLD^VALM1("",LINEVAR,"LCAP")
+3 SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT,LINEVAR)
+4 QUIT
+5 ;
INS(DFN,INS) ; Check if patient has IVF insurance
+1 NEW IBDOS,IBINS,INSCONM,INSCONUM,INSIEN,IVF
+2 ;Date of Service
SET IBDOS=DT
IF $GET(IBENCIFN)
SET IBDOS=$$GET1^DIQ(364.9,IBENCIFN,.12,"I")
+3 DO ALL^IBCNS1(DFN,"IBINS",1,IBDOS,1)
+4 SET (INSIEN,IVF)=0
+5 FOR
SET INSIEN=$ORDER(IBINS(INSIEN))
if 'INSIEN
QUIT
Begin DoDot:1
+6 SET INSCONUM=$PIECE(IBINS(INSIEN,0),U)
+7 SET INSCONM=$$GET1^DIQ(36,INSCONUM_",",.01,"E")
+8 IF INSCONM["IVF"
SET INS("IVF")=""
QUIT
+9 IF INSCONM["REGIONAL COUNCIL"
SET INS("RC")=""
QUIT
+10 IF INSCONM["DEPT OF LABOR"
SET INS("DOL")=""
End DoDot:1
+11 QUIT
+12 ;
HELP ;Help code
+1 NEW X
+2 SET X="?"
DO DISP^XQORM1
WRITE !!
+3 QUIT
+4 ;
EXIT ;Exit code
+1 DO CLEAN^VALM10
+2 DO CLEAR^VALM1
+3 KILL ^TMP("IBACCWLVS",$JOB)
+4 QUIT
+5 ;
EXPND ;Expand code
+1 QUIT
+2 ;
SORTED(VSARRAY,RETURN) ; sorted rated disabilites like they do in registration screens
+1 ;
+2 NEW S1,S2
+3 NEW SORTED
+4 ;
+5 SET S1=2.04
+6 if '$DATA(VSARRAY(S1))
QUIT
+7 ;
+8 SET S2=""
+9 FOR
SET S2=$ORDER(VSARRAY(S1,S2))
if S2=""
QUIT
Begin DoDot:1
+10 NEW DR
+11 ; disability rating (%)
SET DR=$GET(VSARRAY(S1,S2,2,"I"))
+12 SET SORTED(+DR,S2)=""
End DoDot:1
+13 ;
+14 NEW CNT,BLANK,SF
+15 SET SF=2.04
+16 SET CNT=0
SET BLANK=" "
+17 ;get hightest % first
SET S1="A"
FOR
SET S1=$ORDER(SORTED(S1),-1)
if S1=""
QUIT
Begin DoDot:1
+18 SET S2=""
FOR
SET S2=$ORDER(SORTED(S1,S2))
if S2=""
QUIT
Begin DoDot:2
+19 SET CNT=CNT+1
+20 NEW D1,D2,D3,D4,D5,D6,D7
+21 NEW DATA1,DATA2
+22 SET D1=""
IF $DATA(VSARRAY(SF,S2,.01,"I"))
SET D1=$$GET1^DIQ(31,VSARRAY(SF,S2,.01,"I"),2)
+23 SET D2=$EXTRACT($GET(VSARRAY(SF,S2,.01,"E")),1,36)
+24 SET D3=$GET(VSARRAY(SF,S2,2,"I"))
+25 SET D4=$GET(VSARRAY(SF,S2,3,"I"))
+26 SET DATA=D1_"-"_D2_"("_D3_"%"_$SELECT(+D4:" SC",1:"")_")"
+27 SET D5=$GET(VSARRAY(SF,S2,4,"I"))
+28 SET D6=$GET(VSARRAY(SF,S2,5,"E"))
+29 SET D7=$GET(VSARRAY(SF,S2,6,"E"))
+30 SET RETURN(CNT)=$EXTRACT(DATA_BLANK,1,49)_" "_$EXTRACT(D5_BLANK,1,2)_" "_$EXTRACT(D6_BLANK,1,12)_" "_$EXTRACT(D7_BLANK,1,12)
End DoDot:2
End DoDot:1
+31 IF CNT>0
SET RETURN(0)="Rated Disability EA Orig Eff Dt Curr Eff Dt"
+32 QUIT
