IBACCWLAI ;EDE/TPF - ACC (Automated Community Care) Encounters - Action Items Expand and Previous Activity; 12-SEP-2023
;;2.0;INTEGRATED BILLING;**770**;21-MAR-2024;Build 119
;;Per VA Directive 6402, this routine should not be modified.
Q
;This routine contains APIs for Action Items for the ACC Community Care worklists
;
;CALLED BY ACTION PROTOCOL:
;IBACC WL IBACCOMMON EE ACTION
EXPANDENC(IBDA) ;EP - EXPAND ENCOUNTER
;
N DFN,DETRETURN,ENCRETURN,IBBILL,IBENCIFN,IBIFN,IBENCIEN,PREVVALMAR
;
I $D(^TMP("IBACCWLEE",$J)) S VALMBCK="R" Q
;
S VALMSG="* = In progress| ! = Patient not in VistA |??=Help"
;
I '$G(IBDA) N IBDA D SEL(.IBDA) ;I 1 ;IS THIS REALLY ALL I NEED TO MAKE THE APIs ENCOUNTER SPECIFIC?
;
I '$D(IBDA) S VALMBCK="R" Q
;
I $G(IBDA(IBDA))["----------------------",'$O(IBDA(IBDA)) S VALMBCK="R" Q
;
S IBDA=$O(IBDA("")) ;ONLY IF ONE SELECTION. NEED FOR LOOP FOR MULTIPLES
;
I $G(IBPARENT)=0 D ;TPF;IB*2*770v38;EBILL-5485
.S IBENCIFN=$G(@VALMAR@("IEN3649",1))
.S IBIFN=$G(@VALMAR@("IEN399",1))
E D
.S IBIFN=$G(@VALMAR@(IBDA,"IEN399",1))
.S IBENCIFN=$G(@VALMAR@(IBDA,"IEN3649",1))
;
I IBENCIFN S DFN=$P($G(^IBA(364.9,IBENCIFN,2)),U)
E S DFN="NOT FOUND"
;
I IBIFN'="" D
.S DFN=$P($G(^DGCR(399,+$G(IBIFN),0)),U,2)
.S IBBILL=$P($G(^DGCR(399,IBIFN,0)),U)
E D
.W !!,"This encounter does not have a K#."
W:$G(IBBILL)'="" !,"ACC CLAIM/BILL "_IBBILL_" SELECTED" H 2
;
D FULL^VALM1
;
M ENCRETURN=@VALMAR@(1)
I '$D(ENCRETURN) D Q
.W !!,"Error missing data array. Report to eBilling." ;TPF;IB*2*770v11;EBILL-4523 ;CHANGE TO SOP FOR ERROR CHECKS IN WL
.S VALMBCK="R"
.N DIR,DIRUT,DUOUT,DTOUT
.D PAUSE^VALM1
;
;TPF;IB*2*770v4 THIS WAS COMMENTED OUT IN v3
I $G(IBPARENT) D ;TPF;IB*2*770v49;EBILL-6100 THE PARENT COL DEFINITION SETS SHOULD ONLY OCCUR IF COMING IN FROM THE PARENT NOT A CHILD SCREEN
.M IBFROMVALMDDF=VALMDDF ;PASS THE COLUMN SPECS AND ORIGINATING DATA ARRAY FOR UPDATING WHEN ACTION DONE IN EE
.;M IBFROMVALMDDF("HDR")=VALMHDR ;TPF;IB*2*770v49;EBILL-6100 NOT USED
.S IBFROMVALMDDF(1,"NAME")=$G(NAME)
.S IBFROMVALMDDF(1,"VALMAR")=$G(VALMAR)
M DETRETURN=ENCRETURN(IBDA)
S PREVVALMAR=$P($NA(@VALMAR),")")_")"
;
;TPF;IB*2*770v20;BEGIN EBILL-4055 MOD RELEVANT TO THE RU ACTION WITH ACTIVITY CODE 508 FROM EE ONLY
;CHECK SELECTED RECORDS TO SEE IF THEY HAVE BEEN REASSIGNED. BUG FIX FOR BLANK SCREEN ON RETURN FROM ACTION IN EE
I $P(^IBA(364.9,IBENCIFN,3),U)'=$P(SESSIONKEY,"IBACC",2) D S VALMBCK="R" Q ;TPF;****** TESTING BLANKSCREEN FIX ON RETURN FROM ACTION IN EE
.N EEVALMAR
.S EEVALMAR=$G(IBFROMVALMDDF(1,"VALMAR")) ;="^TMP("IBACCWLRUR",$J)"
.W !,"RECORD "_IBDA_" IS NO LONGER AVAILABLE BECAUSE "
.W !,$G(@EEVALMAR@(IBDA,"UNAVAILABLE"))
.N DIR,DUOUT,DTOUT,DIROUT
.S DIR(0)="E"
.D ^DIR
;
D EN^IBACCWLEE(.IBDA,IBENCIFN,IBIFN,.DETRETURN,PREVVALMAR,.IBFROMVALMDDF)
;
S IBICAMEFROMEE=1
S VALMBCK="R"
Q
;
;S DA(1)=1 D PREVACT^IBACCWLAI(.DA)
;CALLED BY ACTION PROTOCOL:
;IBACC WL IBACCCOMMON PREV ACTIVITY
PREVACT(IBDA,IBIFN,IBLN) ;EP - DISPLAY/VIEW ALL PREVIOUS ACTIVITY
N IBIFN,DFN,ERROR,RECORD,PREVACTIEN,PREVACTRET,LINENUM
;
S VALMSG="* = In progress| ! = Patient not in VistA |??=Help"
;
I '$G(IBDA) N IBDA D SEL(.IBDA) ;I 1 IS THIS REALLY ALL I NEED TO MAKE THE APIs ENCOUNTER SPECIFIC?
;
I '$D(IBDA) S VALMBCK="R" Q
;
I $G(IBDA(IBDA))["----------------------",'$O(IBDA(IBDA)) S VALMBCK="R" Q
;
;I VALMAR[("IBACCWLEE")!(VALMAR[("IBACCWLVERUR")) D ;TPF;IB*2*770v38;EBILL-5485
;IBPARENT=0 SHOWS IT IS A "CHILD" SCREEN!
I $G(IBPARENT)=0 D ;TPF;IB*2*770v38;EBILL-5485
.S IBENCIFN=$G(@VALMAR@("IEN3649",1))
.S IBIFN=$G(@VALMAR@("IEN399",1))
E D
.S IBIFN=$G(@VALMAR@(IBDA,"IEN399",1))
.S IBENCIFN=$G(@VALMAR@(IBDA,"IEN3649",1))
;
I IBENCIFN S DFN=$P($G(^IBA(364.9,IBENCIFN,2)),U)
E S DFN="NOT FOUND IN ENCOUNTER FILE"
;
I IBIFN'="" D
.S DFN=$P($G(^DGCR(399,+$G(IBIFN),0)),U,2)
.S IBBILL=$P($G(^DGCR(399,IBIFN,0)),U)
E S DFN="NOT FOUND"
;
D FULL^VALM1
;
D EN^IBACCWLPREV(IBENCIFN,IBIFN)
;
Q
;
;CALLED BY ACTION PROTOCOL 'IBACC WL IBACC RR'
RURREVIEW ;EP - NEW DESIGN RUR REVIEW SCREEN EBILL-5721
N DFN,DETRETURN,ENCRETURN,IBBILL,IBENCIFN,IBIFN,IBENCIEN,PREVVALMAR
;
;CHECK TO SEE IF USER ALREADY HAS INSTANTIATED VE
;TPF;IB*2*770v49;EBILL-5485,EBILL-6100
I $D(^TMP("IBACCWLRURREV",$J)) S VALMBCK="R" Q
;
S VALMSG="* = In progress| ! = Patient not in VistA |??=Help"
;
I '$G(IBDA) N IBDA D SEL(.IBDA) ;I 1 ;IS THIS REALLY ALL I NEED TO MAKE THE APIs ENCOUNTER SPECIFIC?
;
I '$D(IBDA) S VALMBCK="R" Q
;
I $G(IBDA(IBDA))["----------------------",'$O(IBDA(IBDA)) S VALMBCK="R" Q
;
S IBDA=$O(IBDA("")) ;ONLY IF ONE SELECTION. NEED FOR LOOP FOR MULTIPLES
;
;BEGIN TPF;IB*2*770v38;EBILL-5485
;I (VALMAR[("IBACCWLVERUR"))!(VALMAR[("IBACCWLVEE")) D
I $G(IBPARENT)=0 D ;TPF;IB*2*770v38;EBILL-5485
.S IBENCIFN=$G(@VALMAR@("IEN3649",1))
.S IBIFN=$G(@VALMAR@("IEN399",1))
E D
.S IBIFN=$G(@VALMAR@(IBDA,"IEN399",1))
.S IBENCIFN=$G(@VALMAR@(IBDA,"IEN3649",1))
;
I IBENCIFN S DFN=$P($G(^IBA(364.9,IBENCIFN,2)),U)
E S DFN="NOT FOUND"
;
I IBIFN'="" D
.S DFN=$P($G(^DGCR(399,+$G(IBIFN),0)),U,2)
.S IBBILL=$P($G(^DGCR(399,IBIFN,0)),U)
E D
.W !!,"This encounter does not have a K#, only information"
.W !,"from the incoming encounter is available for display." ;W !,"ENCOUNTER HAS NO ENTRY IN #399 BILL/CLAIM FILE" S DFN="NOT FOUND"
W:$G(IBBILL)'="" !,"ACC CLAIM/BILL "_IBBILL_" SELECTED" H 2
;
D FULL^VALM1
;
;TPF;IB*2*770v4 THIS WAS COMMENTED OUT IN v3
;M IBFROMVALMDDF=VALMDDF ;PASS THE COLUMN SPECS AND ORIGINATING DATA ARRAY FOR UPDATING WHEN ACTION DONE IN EE
;M IBFROMVALMDDF("HDR")=VALMHDR ;TPF;IB*2*770v48;EBILL-6100 NOT USED
;S IBFROMVALMDDF(1,"NAME")=$G(NAME)
;S IBFROMVALMDDF(1,"VALMAR")=$G(VALMAR)
I $G(IBPARENT) D ;TPF;IB*2*770v49;EBILL-6100 THE PARENT COL DEFINITION SETS SHOULD ONLY OCCUR IF COMING IN FROM THE PARENT NOT A CHILD SCREEN
.M IBFROMVALMDDF=VALMDDF
.S IBFROMVALMDDF(1,"NAME")=$G(NAME)
.S IBFROMVALMDDF(1,"VALMAR")=$G(VALMAR)
M DETRETURN=ENCRETURN(IBDA)
S PREVVALMAR=$P($NA(@VALMAR),")")_")"
;
D EN^IBACCWLRURREV(.IBDA,IBENCIFN,IBIFN,.DETRETURN,PREVVALMAR,.IBFROMVALMDDF)
;
S VALMBCK="R"
;
Q
;
SEL(IBDA,OPTION) ;EP -
K IBDA,VALMY
D FULL^VALM1
D EN^VALM2($G(XQORNOD(0)),$S($G(OPTION)'="":OPTION,1:"S"))
Q:'$D(VALMY)
;
S IBDA("TOTAL")=0
S IBDA=0
F S IBDA=$O(VALMY(IBDA)) Q:'IBDA D
.S IBDA(IBDA)=$G(@VALMAR@(+IBDA,0))
.S IBDA("TOTAL")=IBDA("TOTAL")+1
S IBDA=$O(IBDA("")) ;ONLY IF ONE SELECTION. NEED FOR LOOP FOR MULTIPLES
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBACCWLAI 6742 printed May 25, 2026@12:09:47 Page 2
IBACCWLAI ;EDE/TPF - ACC (Automated Community Care) Encounters - Action Items Expand and Previous Activity; 12-SEP-2023
+1 ;;2.0;INTEGRATED BILLING;**770**;21-MAR-2024;Build 119
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;This routine contains APIs for Action Items for the ACC Community Care worklists
+5 ;
+6 ;CALLED BY ACTION PROTOCOL:
+7 ;IBACC WL IBACCOMMON EE ACTION
EXPANDENC(IBDA) ;EP - EXPAND ENCOUNTER
+1 ;
+2 NEW DFN,DETRETURN,ENCRETURN,IBBILL,IBENCIFN,IBIFN,IBENCIEN,PREVVALMAR
+3 ;
+4 IF $DATA(^TMP("IBACCWLEE",$JOB))
SET VALMBCK="R"
QUIT
+5 ;
+6 SET VALMSG="* = In progress| ! = Patient not in VistA |??=Help"
+7 ;
+8 ;I 1 ;IS THIS REALLY ALL I NEED TO MAKE THE APIs ENCOUNTER SPECIFIC?
IF '$GET(IBDA)
NEW IBDA
DO SEL(.IBDA)
+9 ;
+10 IF '$DATA(IBDA)
SET VALMBCK="R"
QUIT
+11 ;
+12 IF $GET(IBDA(IBDA))["----------------------"
IF '$ORDER(IBDA(IBDA))
SET VALMBCK="R"
QUIT
+13 ;
+14 ;ONLY IF ONE SELECTION. NEED FOR LOOP FOR MULTIPLES
SET IBDA=$ORDER(IBDA(""))
+15 ;
+16 ;TPF;IB*2*770v38;EBILL-5485
IF $GET(IBPARENT)=0
Begin DoDot:1
+17 SET IBENCIFN=$GET(@VALMAR@("IEN3649",1))
+18 SET IBIFN=$GET(@VALMAR@("IEN399",1))
End DoDot:1
+19 IF '$TEST
Begin DoDot:1
+20 SET IBIFN=$GET(@VALMAR@(IBDA,"IEN399",1))
+21 SET IBENCIFN=$GET(@VALMAR@(IBDA,"IEN3649",1))
End DoDot:1
+22 ;
+23 IF IBENCIFN
SET DFN=$PIECE($GET(^IBA(364.9,IBENCIFN,2)),U)
+24 IF '$TEST
SET DFN="NOT FOUND"
+25 ;
+26 IF IBIFN'=""
Begin DoDot:1
+27 SET DFN=$PIECE($GET(^DGCR(399,+$GET(IBIFN),0)),U,2)
+28 SET IBBILL=$PIECE($GET(^DGCR(399,IBIFN,0)),U)
End DoDot:1
+29 IF '$TEST
Begin DoDot:1
+30 WRITE !!,"This encounter does not have a K#."
End DoDot:1
+31 if $GET(IBBILL)'=""
WRITE !,"ACC CLAIM/BILL "_IBBILL_" SELECTED"
HANG 2
+32 ;
+33 DO FULL^VALM1
+34 ;
+35 MERGE ENCRETURN=@VALMAR@(1)
+36 IF '$DATA(ENCRETURN)
Begin DoDot:1
+37 ;TPF;IB*2*770v11;EBILL-4523 ;CHANGE TO SOP FOR ERROR CHECKS IN WL
WRITE !!,"Error missing data array. Report to eBilling."
+38 SET VALMBCK="R"
+39 NEW DIR,DIRUT,DUOUT,DTOUT
+40 DO PAUSE^VALM1
End DoDot:1
QUIT
+41 ;
+42 ;TPF;IB*2*770v4 THIS WAS COMMENTED OUT IN v3
+43 ;TPF;IB*2*770v49;EBILL-6100 THE PARENT COL DEFINITION SETS SHOULD ONLY OCCUR IF COMING IN FROM THE PARENT NOT A CHILD SCREEN
IF $GET(IBPARENT)
Begin DoDot:1
+44 ;PASS THE COLUMN SPECS AND ORIGINATING DATA ARRAY FOR UPDATING WHEN ACTION DONE IN EE
MERGE IBFROMVALMDDF=VALMDDF
+45 ;M IBFROMVALMDDF("HDR")=VALMHDR ;TPF;IB*2*770v49;EBILL-6100 NOT USED
+46 SET IBFROMVALMDDF(1,"NAME")=$GET(NAME)
+47 SET IBFROMVALMDDF(1,"VALMAR")=$GET(VALMAR)
End DoDot:1
+48 MERGE DETRETURN=ENCRETURN(IBDA)
+49 SET PREVVALMAR=$PIECE($NAME(@VALMAR),")")_")"
+50 ;
+51 ;TPF;IB*2*770v20;BEGIN EBILL-4055 MOD RELEVANT TO THE RU ACTION WITH ACTIVITY CODE 508 FROM EE ONLY
+52 ;CHECK SELECTED RECORDS TO SEE IF THEY HAVE BEEN REASSIGNED. BUG FIX FOR BLANK SCREEN ON RETURN FROM ACTION IN EE
+53 ;TPF;****** TESTING BLANKSCREEN FIX ON RETURN FROM ACTION IN EE
IF $PIECE(^IBA(364.9,IBENCIFN,3),U)'=$PIECE(SESSIONKEY,"IBACC",2)
Begin DoDot:1
+54 NEW EEVALMAR
+55 ;="^TMP("IBACCWLRUR",$J)"
SET EEVALMAR=$GET(IBFROMVALMDDF(1,"VALMAR"))
+56 WRITE !,"RECORD "_IBDA_" IS NO LONGER AVAILABLE BECAUSE "
+57 WRITE !,$GET(@EEVALMAR@(IBDA,"UNAVAILABLE"))
+58 NEW DIR,DUOUT,DTOUT,DIROUT
+59 SET DIR(0)="E"
+60 DO ^DIR
End DoDot:1
SET VALMBCK="R"
QUIT
+61 ;
+62 DO EN^IBACCWLEE(.IBDA,IBENCIFN,IBIFN,.DETRETURN,PREVVALMAR,.IBFROMVALMDDF)
+63 ;
+64 SET IBICAMEFROMEE=1
+65 SET VALMBCK="R"
+66 QUIT
+67 ;
+68 ;S DA(1)=1 D PREVACT^IBACCWLAI(.DA)
+69 ;CALLED BY ACTION PROTOCOL:
+70 ;IBACC WL IBACCCOMMON PREV ACTIVITY
PREVACT(IBDA,IBIFN,IBLN) ;EP - DISPLAY/VIEW ALL PREVIOUS ACTIVITY
+1 NEW IBIFN,DFN,ERROR,RECORD,PREVACTIEN,PREVACTRET,LINENUM
+2 ;
+3 SET VALMSG="* = In progress| ! = Patient not in VistA |??=Help"
+4 ;
+5 ;I 1 IS THIS REALLY ALL I NEED TO MAKE THE APIs ENCOUNTER SPECIFIC?
IF '$GET(IBDA)
NEW IBDA
DO SEL(.IBDA)
+6 ;
+7 IF '$DATA(IBDA)
SET VALMBCK="R"
QUIT
+8 ;
+9 IF $GET(IBDA(IBDA))["----------------------"
IF '$ORDER(IBDA(IBDA))
SET VALMBCK="R"
QUIT
+10 ;
+11 ;I VALMAR[("IBACCWLEE")!(VALMAR[("IBACCWLVERUR")) D ;TPF;IB*2*770v38;EBILL-5485
+12 ;IBPARENT=0 SHOWS IT IS A "CHILD" SCREEN!
+13 ;TPF;IB*2*770v38;EBILL-5485
IF $GET(IBPARENT)=0
Begin DoDot:1
+14 SET IBENCIFN=$GET(@VALMAR@("IEN3649",1))
+15 SET IBIFN=$GET(@VALMAR@("IEN399",1))
End DoDot:1
+16 IF '$TEST
Begin DoDot:1
+17 SET IBIFN=$GET(@VALMAR@(IBDA,"IEN399",1))
+18 SET IBENCIFN=$GET(@VALMAR@(IBDA,"IEN3649",1))
End DoDot:1
+19 ;
+20 IF IBENCIFN
SET DFN=$PIECE($GET(^IBA(364.9,IBENCIFN,2)),U)
+21 IF '$TEST
SET DFN="NOT FOUND IN ENCOUNTER FILE"
+22 ;
+23 IF IBIFN'=""
Begin DoDot:1
+24 SET DFN=$PIECE($GET(^DGCR(399,+$GET(IBIFN),0)),U,2)
+25 SET IBBILL=$PIECE($GET(^DGCR(399,IBIFN,0)),U)
End DoDot:1
+26 IF '$TEST
SET DFN="NOT FOUND"
+27 ;
+28 DO FULL^VALM1
+29 ;
+30 DO EN^IBACCWLPREV(IBENCIFN,IBIFN)
+31 ;
+32 QUIT
+33 ;
+34 ;CALLED BY ACTION PROTOCOL 'IBACC WL IBACC RR'
RURREVIEW ;EP - NEW DESIGN RUR REVIEW SCREEN EBILL-5721
+1 NEW DFN,DETRETURN,ENCRETURN,IBBILL,IBENCIFN,IBIFN,IBENCIEN,PREVVALMAR
+2 ;
+3 ;CHECK TO SEE IF USER ALREADY HAS INSTANTIATED VE
+4 ;TPF;IB*2*770v49;EBILL-5485,EBILL-6100
+5 IF $DATA(^TMP("IBACCWLRURREV",$JOB))
SET VALMBCK="R"
QUIT
+6 ;
+7 SET VALMSG="* = In progress| ! = Patient not in VistA |??=Help"
+8 ;
+9 ;I 1 ;IS THIS REALLY ALL I NEED TO MAKE THE APIs ENCOUNTER SPECIFIC?
IF '$GET(IBDA)
NEW IBDA
DO SEL(.IBDA)
+10 ;
+11 IF '$DATA(IBDA)
SET VALMBCK="R"
QUIT
+12 ;
+13 IF $GET(IBDA(IBDA))["----------------------"
IF '$ORDER(IBDA(IBDA))
SET VALMBCK="R"
QUIT
+14 ;
+15 ;ONLY IF ONE SELECTION. NEED FOR LOOP FOR MULTIPLES
SET IBDA=$ORDER(IBDA(""))
+16 ;
+17 ;BEGIN TPF;IB*2*770v38;EBILL-5485
+18 ;I (VALMAR[("IBACCWLVERUR"))!(VALMAR[("IBACCWLVEE")) D
+19 ;TPF;IB*2*770v38;EBILL-5485
IF $GET(IBPARENT)=0
Begin DoDot:1
+20 SET IBENCIFN=$GET(@VALMAR@("IEN3649",1))
+21 SET IBIFN=$GET(@VALMAR@("IEN399",1))
End DoDot:1
+22 IF '$TEST
Begin DoDot:1
+23 SET IBIFN=$GET(@VALMAR@(IBDA,"IEN399",1))
+24 SET IBENCIFN=$GET(@VALMAR@(IBDA,"IEN3649",1))
End DoDot:1
+25 ;
+26 IF IBENCIFN
SET DFN=$PIECE($GET(^IBA(364.9,IBENCIFN,2)),U)
+27 IF '$TEST
SET DFN="NOT FOUND"
+28 ;
+29 IF IBIFN'=""
Begin DoDot:1
+30 SET DFN=$PIECE($GET(^DGCR(399,+$GET(IBIFN),0)),U,2)
+31 SET IBBILL=$PIECE($GET(^DGCR(399,IBIFN,0)),U)
End DoDot:1
+32 IF '$TEST
Begin DoDot:1
+33 WRITE !!,"This encounter does not have a K#, only information"
+34 ;W !,"ENCOUNTER HAS NO ENTRY IN #399 BILL/CLAIM FILE" S DFN="NOT FOUND"
WRITE !,"from the incoming encounter is available for display."
End DoDot:1
+35 if $GET(IBBILL)'=""
WRITE !,"ACC CLAIM/BILL "_IBBILL_" SELECTED"
HANG 2
+36 ;
+37 DO FULL^VALM1
+38 ;
+39 ;TPF;IB*2*770v4 THIS WAS COMMENTED OUT IN v3
+40 ;M IBFROMVALMDDF=VALMDDF ;PASS THE COLUMN SPECS AND ORIGINATING DATA ARRAY FOR UPDATING WHEN ACTION DONE IN EE
+41 ;M IBFROMVALMDDF("HDR")=VALMHDR ;TPF;IB*2*770v48;EBILL-6100 NOT USED
+42 ;S IBFROMVALMDDF(1,"NAME")=$G(NAME)
+43 ;S IBFROMVALMDDF(1,"VALMAR")=$G(VALMAR)
+44 ;TPF;IB*2*770v49;EBILL-6100 THE PARENT COL DEFINITION SETS SHOULD ONLY OCCUR IF COMING IN FROM THE PARENT NOT A CHILD SCREEN
IF $GET(IBPARENT)
Begin DoDot:1
+45 MERGE IBFROMVALMDDF=VALMDDF
+46 SET IBFROMVALMDDF(1,"NAME")=$GET(NAME)
+47 SET IBFROMVALMDDF(1,"VALMAR")=$GET(VALMAR)
End DoDot:1
+48 MERGE DETRETURN=ENCRETURN(IBDA)
+49 SET PREVVALMAR=$PIECE($NAME(@VALMAR),")")_")"
+50 ;
+51 DO EN^IBACCWLRURREV(.IBDA,IBENCIFN,IBIFN,.DETRETURN,PREVVALMAR,.IBFROMVALMDDF)
+52 ;
+53 SET VALMBCK="R"
+54 ;
+55 QUIT
+56 ;
SEL(IBDA,OPTION) ;EP -
+1 KILL IBDA,VALMY
+2 DO FULL^VALM1
+3 DO EN^VALM2($GET(XQORNOD(0)),$SELECT($GET(OPTION)'="":OPTION,1:"S"))
+4 if '$DATA(VALMY)
QUIT
+5 ;
+6 SET IBDA("TOTAL")=0
+7 SET IBDA=0
+8 FOR
SET IBDA=$ORDER(VALMY(IBDA))
if 'IBDA
QUIT
Begin DoDot:1
+9 SET IBDA(IBDA)=$GET(@VALMAR@(+IBDA,0))
+10 SET IBDA("TOTAL")=IBDA("TOTAL")+1
End DoDot:1
+11 ;ONLY IF ONE SELECTION. NEED FOR LOOP FOR MULTIPLES
SET IBDA=$ORDER(IBDA(""))
+12 ;
+13 QUIT
