PRCAMDA1 ;ALB/TAZ - PRCA MDA WORKLIST SCREEN ;18-APR-2011
;;4.5;Accounts Receivable;**275**;Mar 20, 1995;Build 72
;;Per VHA Directive 2004-038, this routine should not be modified.
;DBIA #3820
;
EN ; -- main entry point for MDA Worklist
N PRCAEDT,PRCASDT,PRCASORT,PRCAQUIT,PRCASDV
N VALMBCK,VALMCNT,VALMHDR,VALMQUIT
D EN^VALM("PRCA MDA WORKLIST")
Q
;
HDR ; -- header code
S VALMHDR(1)="Part A Inpatient"
S VALMHDR(2)=""
Q
;
INIT ; -- init variables and list array
N DIC,DIRUT,DIROUT,DTOUT,DUOUT,X,Y,DIR,LN,PRCADIV
K ^TMP("PRCAMDA",$J),^TMP($J,"PRCAMDA")
S PRCAQUIT=0
;
D DIV(.PRCASDV) ;Build list of Divisions (or all divisions)
I PRCAQUIT=1 S VALMQUIT="" G INITQ
;
D DTR(.PRCASDT,.PRCAEDT) ;Get Worklist Dates
I PRCAQUIT=1 S VALMQUIT="" G INITQ
;
D SORT(.PRCASORT) ;Get Worklist Sort Direction
I PRCAQUIT=1 S VALMQUIT="" G INITQ
;
D BLD ;Build Arrays
;
INITQ ;
Q
;
BLD ; -- Build the Arrays
;Build the DIV array
K ^TMP($J,"PRCAMDA","DIV")
S PRCAIEN=""
F S PRCAIEN=$O(^PRCA(436.1,"AMDA",1,PRCAIEN),PRCASORT) Q:'PRCAIEN D
. N PRCARDT,PRCAOK
. S PRCARDT=$$GET1^DIQ(436.1,PRCAIEN_", ",.1,"I") I PRCARDT>PRCAEDT!(PRCARDT<PRCASDT) Q ;Not in Date Range
. S PRCADIV=$$GET1^DIQ(436.1,PRCAIEN_", ",1.03,"I") I 'PRCADIV S PRCADIV="99999"
. I PRCASDV,'$D(^TMP($J,"PRCAMDA","DIV",PRCADIV)) Q ; Not a selected division
. S ^TMP($J,"PRCAMDA","DIV",PRCADIV,PRCAIEN)=""
;
; Build the List Array.
S PRCADIV="",(LN,VALMCNT)=0
F S PRCADIV=$O(^TMP($J,"PRCAMDA","DIV",PRCADIV)) Q:'PRCADIV D
. D SET("Division: "_$S(PRCADIV=99999:"Unknown",1:$P(^DG(40.8,PRCADIV,0),U,1)),LN+1)
. S PRCAIEN=""
. F S PRCAIEN=$O(^TMP($J,"PRCAMDA","DIV",PRCADIV,PRCAIEN)) Q:'PRCAIEN D
.. N PRCABN,PRCAFN,PRCAPN,PRCARS,LINEVAR
.. S PRCABN=$$GET1^DIQ(436.1,PRCAIEN_", ",.01,"I"),PRCAPN="Unknown Patient"
.. S PRCAFN=$$GET1^DIQ(436.1,PRCAIEN_", ",1.01,"I") I PRCAFN S PRCAPN=$$GET1^DIQ(399,PRCAFN_", ",.02,"E") ;DBIA #3820
.. S PRCARS=$$GET1^DIQ(436.1,PRCAIEN_", ",1.02,"I")=1 ;Only place asterisk on REVIEW IN PROCESS entries.
.. S LINEVAR=""
.. S LN=LN+1
.. S LINEVAR=$$SETFLD^VALM1(LN,LINEVAR,"NUMBER")
.. S LINEVAR=$$SETFLD^VALM1(PRCABN,LINEVAR,"BILL")
.. I PRCARS S LINEVAR=$$SETSTR^VALM1("*",LINEVAR,15,15)
.. S LINEVAR=$$SETFLD^VALM1(PRCAPN,LINEVAR,"PTNAME")
.. S LINEVAR=$$SETFLD^VALM1($$GET1^DIQ(436.1,PRCAIEN_", ",.03,"I"),LINEVAR,"SUBID")
.. S LINEVAR=$$SETFLD^VALM1(" "_$P($$FMTE^XLFDT($$GET1^DIQ(436.1,PRCAIEN_", ",.08,"I"),"7D"),"/",1),LINEVAR,"SYEAR")
.. S LINEVAR=$$SETFLD^VALM1(" "_$P($$FMTE^XLFDT($$GET1^DIQ(436.1,PRCAIEN_", ",.09,"I"),"7D"),"/",1),LINEVAR,"EYEAR")
.. S LINEVAR=$$SETFLD^VALM1($J($$GET1^DIQ(436.1,PRCAIEN_", ",.06,"I"),6),LINEVAR,"DEDSUB")
.. S LINEVAR=$$SETFLD^VALM1($J($$GET1^DIQ(436.1,PRCAIEN_", ",.07,"I"),6),LINEVAR,"DEDAVL")
.. S LINEVAR=$$SETFLD^VALM1($J($$FMTE^XLFDT($$GET1^DIQ(436.1,PRCAIEN_", ",.1,"I"),"2DZ"),8),LINEVAR,"RPTDT")
.. D SET(LINEVAR,LN,PRCAIEN)
BLDQ ;
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("PRCAMDA",$J),^TMP($J,"PRCAMDA","DIV")
D CLEAN^VALM10
Q
;
;Output:
;^TMP($J,"PRCAMDA","DIV",<div>) - List of selected divisions
;PRCASDV - Selected division switch - 1 = Divisions selected, 0 = all divisions
DIV(PRCASDV) ; Get Division
N DIC,Y,PRCA1ST
K ^TMP($J,"PRCAMDA","DIV")
S PRCA1ST=1
F D Q:(Y<0)!PRCAQUIT
. S DIC="^DG(40.8,",DIC(0)="AEQMN",DIC("A")="Select "_$S(PRCA1ST:"",1:" Another ")_"Division: "_$S(PRCA1ST:"All Divisions// ",1:"")
. D ^DIC
. K DIC
. I Y<0 W:PRCA1ST " All Divisions" S PRCASDV=0 Q
. I $D(DTOUT)!$D(DUOUT) S PRCAQUIT=1 Q
. S ^TMP($J,"PRCAMDA","DIV",+Y)="",PRCA1ST=0
;
DIVX ;
Q
;
;Output:
;PRCASDT - Worklist Earliest Report Date
;PRCAEDT - Worklist Latest Report Date
;
DTR(PRCASDT,PRCAEDT) ;date range
N %DT,DTOUT,DUOUT,X,Y
S %DT="AEX"
S %DT("A")="Select Earliest Report Date: ",%DT("B")="TODAY-7"
W ! D ^%DT ;K %DT
I $D(DTOUT)!$D(DUOUT)!(Y<0) S PRCAQUIT=1 G DTRX
S PRCASDT=+Y
S %DT="AEX"
S %DT("A")="Select Latest Report Date: ",%DT("B")="TODAY"
D ^%DT ;K %DT
I $D(DTOUT)!$D(DUOUT)!(Y<0) S PRCAQUIT=1 G DTRX
S PRCAEDT=+Y
;
DTRX ;
Q
;
;Output:
;PRCASORT - Direction of report entries.
;
SORT(PRCASORT) ;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="SA^1:Earliest Report Date;2:Latest Report Date"
S DIR("A")="Sort Report By: "
S DIR("B")="Latest Report Date"
D ^DIR
I $D(DTOUT)!$D(DUOUT)!(Y<0) S PRCAQUIT=1 G SORTX
S PRCASORT=$S(Y=2:"-1",1:"+1")
;
SORTX ;
Q
;
SET(X,CNT,PRCAIEN) ;set up list manager screen array
S VALMCNT=VALMCNT+1
S ^TMP("PRCAMDA",$J,VALMCNT,0)=X
S ^TMP("PRCAMDA",$J,"IDX",VALMCNT,CNT)=""
I $G(PRCAIEN),$G(^TMP("PRCAMDA",$J,CNT))="" S ^TMP("PRCAMDA",$J,CNT)=VALMCNT_U_PRCAIEN
Q
;
EXP ; -- expand code to show additional details of the EOB record
S VALMBCK="R"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAMDA1 4948 printed Mar 13, 2025@20:45:04 Page 2
PRCAMDA1 ;ALB/TAZ - PRCA MDA WORKLIST SCREEN ;18-APR-2011
+1 ;;4.5;Accounts Receivable;**275**;Mar 20, 1995;Build 72
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;DBIA #3820
+4 ;
EN ; -- main entry point for MDA Worklist
+1 NEW PRCAEDT,PRCASDT,PRCASORT,PRCAQUIT,PRCASDV
+2 NEW VALMBCK,VALMCNT,VALMHDR,VALMQUIT
+3 DO EN^VALM("PRCA MDA WORKLIST")
+4 QUIT
+5 ;
HDR ; -- header code
+1 SET VALMHDR(1)="Part A Inpatient"
+2 SET VALMHDR(2)=""
+3 QUIT
+4 ;
INIT ; -- init variables and list array
+1 NEW DIC,DIRUT,DIROUT,DTOUT,DUOUT,X,Y,DIR,LN,PRCADIV
+2 KILL ^TMP("PRCAMDA",$JOB),^TMP($JOB,"PRCAMDA")
+3 SET PRCAQUIT=0
+4 ;
+5 ;Build list of Divisions (or all divisions)
DO DIV(.PRCASDV)
+6 IF PRCAQUIT=1
SET VALMQUIT=""
GOTO INITQ
+7 ;
+8 ;Get Worklist Dates
DO DTR(.PRCASDT,.PRCAEDT)
+9 IF PRCAQUIT=1
SET VALMQUIT=""
GOTO INITQ
+10 ;
+11 ;Get Worklist Sort Direction
DO SORT(.PRCASORT)
+12 IF PRCAQUIT=1
SET VALMQUIT=""
GOTO INITQ
+13 ;
+14 ;Build Arrays
DO BLD
+15 ;
INITQ ;
+1 QUIT
+2 ;
BLD ; -- Build the Arrays
+1 ;Build the DIV array
+2 KILL ^TMP($JOB,"PRCAMDA","DIV")
+3 SET PRCAIEN=""
+4 FOR
SET PRCAIEN=$ORDER(^PRCA(436.1,"AMDA",1,PRCAIEN),PRCASORT)
if 'PRCAIEN
QUIT
Begin DoDot:1
+5 NEW PRCARDT,PRCAOK
+6 ;Not in Date Range
SET PRCARDT=$$GET1^DIQ(436.1,PRCAIEN_", ",.1,"I")
IF PRCARDT>PRCAEDT!(PRCARDT<PRCASDT)
QUIT
+7 SET PRCADIV=$$GET1^DIQ(436.1,PRCAIEN_", ",1.03,"I")
IF 'PRCADIV
SET PRCADIV="99999"
+8 ; Not a selected division
IF PRCASDV
IF '$DATA(^TMP($JOB,"PRCAMDA","DIV",PRCADIV))
QUIT
+9 SET ^TMP($JOB,"PRCAMDA","DIV",PRCADIV,PRCAIEN)=""
End DoDot:1
+10 ;
+11 ; Build the List Array.
+12 SET PRCADIV=""
SET (LN,VALMCNT)=0
+13 FOR
SET PRCADIV=$ORDER(^TMP($JOB,"PRCAMDA","DIV",PRCADIV))
if 'PRCADIV
QUIT
Begin DoDot:1
+14 DO SET("Division: "_$SELECT(PRCADIV=99999:"Unknown",1:$PIECE(^DG(40.8,PRCADIV,0),U,1)),LN+1)
+15 SET PRCAIEN=""
+16 FOR
SET PRCAIEN=$ORDER(^TMP($JOB,"PRCAMDA","DIV",PRCADIV,PRCAIEN))
if 'PRCAIEN
QUIT
Begin DoDot:2
+17 NEW PRCABN,PRCAFN,PRCAPN,PRCARS,LINEVAR
+18 SET PRCABN=$$GET1^DIQ(436.1,PRCAIEN_", ",.01,"I")
SET PRCAPN="Unknown Patient"
+19 ;DBIA #3820
SET PRCAFN=$$GET1^DIQ(436.1,PRCAIEN_", ",1.01,"I")
IF PRCAFN
SET PRCAPN=$$GET1^DIQ(399,PRCAFN_", ",.02,"E")
+20 ;Only place asterisk on REVIEW IN PROCESS entries.
SET PRCARS=$$GET1^DIQ(436.1,PRCAIEN_", ",1.02,"I")=1
+21 SET LINEVAR=""
+22 SET LN=LN+1
+23 SET LINEVAR=$$SETFLD^VALM1(LN,LINEVAR,"NUMBER")
+24 SET LINEVAR=$$SETFLD^VALM1(PRCABN,LINEVAR,"BILL")
+25 IF PRCARS
SET LINEVAR=$$SETSTR^VALM1("*",LINEVAR,15,15)
+26 SET LINEVAR=$$SETFLD^VALM1(PRCAPN,LINEVAR,"PTNAME")
+27 SET LINEVAR=$$SETFLD^VALM1($$GET1^DIQ(436.1,PRCAIEN_", ",.03,"I"),LINEVAR,"SUBID")
+28 SET LINEVAR=$$SETFLD^VALM1(" "_$PIECE($$FMTE^XLFDT($$GET1^DIQ(436.1,PRCAIEN_", ",.08,"I"),"7D"),"/",1),LINEVAR,"SYEAR")
+29 SET LINEVAR=$$SETFLD^VALM1(" "_$PIECE($$FMTE^XLFDT($$GET1^DIQ(436.1,PRCAIEN_", ",.09,"I"),"7D"),"/",1),LINEVAR,"EYEAR")
+30 SET LINEVAR=$$SETFLD^VALM1($JUSTIFY($$GET1^DIQ(436.1,PRCAIEN_", ",.06,"I"),6),LINEVAR,"DEDSUB")
+31 SET LINEVAR=$$SETFLD^VALM1($JUSTIFY($$GET1^DIQ(436.1,PRCAIEN_", ",.07,"I"),6),LINEVAR,"DEDAVL")
+32 SET LINEVAR=$$SETFLD^VALM1($JUSTIFY($$FMTE^XLFDT($$GET1^DIQ(436.1,PRCAIEN_", ",.1,"I"),"2DZ"),8),LINEVAR,"RPTDT")
+33 DO SET(LINEVAR,LN,PRCAIEN)
End DoDot:2
End DoDot:1
BLDQ ;
+1 QUIT
+2 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("PRCAMDA",$JOB),^TMP($JOB,"PRCAMDA","DIV")
+2 DO CLEAN^VALM10
+3 QUIT
+4 ;
+5 ;Output:
+6 ;^TMP($J,"PRCAMDA","DIV",<div>) - List of selected divisions
+7 ;PRCASDV - Selected division switch - 1 = Divisions selected, 0 = all divisions
DIV(PRCASDV) ; Get Division
+1 NEW DIC,Y,PRCA1ST
+2 KILL ^TMP($JOB,"PRCAMDA","DIV")
+3 SET PRCA1ST=1
+4 FOR
Begin DoDot:1
+5 SET DIC="^DG(40.8,"
SET DIC(0)="AEQMN"
SET DIC("A")="Select "_$SELECT(PRCA1ST:"",1:" Another ")_"Division: "_$SELECT(PRCA1ST:"All Divisions// ",1:"")
+6 DO ^DIC
+7 KILL DIC
+8 IF Y<0
if PRCA1ST
WRITE " All Divisions"
SET PRCASDV=0
QUIT
+9 IF $DATA(DTOUT)!$DATA(DUOUT)
SET PRCAQUIT=1
QUIT
+10 SET ^TMP($JOB,"PRCAMDA","DIV",+Y)=""
SET PRCA1ST=0
End DoDot:1
if (Y<0)!PRCAQUIT
QUIT
+11 ;
DIVX ;
+1 QUIT
+2 ;
+3 ;Output:
+4 ;PRCASDT - Worklist Earliest Report Date
+5 ;PRCAEDT - Worklist Latest Report Date
+6 ;
DTR(PRCASDT,PRCAEDT) ;date range
+1 NEW %DT,DTOUT,DUOUT,X,Y
+2 SET %DT="AEX"
+3 SET %DT("A")="Select Earliest Report Date: "
SET %DT("B")="TODAY-7"
+4 ;K %DT
WRITE !
DO ^%DT
+5 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y<0)
SET PRCAQUIT=1
GOTO DTRX
+6 SET PRCASDT=+Y
+7 SET %DT="AEX"
+8 SET %DT("A")="Select Latest Report Date: "
SET %DT("B")="TODAY"
+9 ;K %DT
DO ^%DT
+10 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y<0)
SET PRCAQUIT=1
GOTO DTRX
+11 SET PRCAEDT=+Y
+12 ;
DTRX ;
+1 QUIT
+2 ;
+3 ;Output:
+4 ;PRCASORT - Direction of report entries.
+5 ;
SORT(PRCASORT) ;
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 WRITE !
+3 SET DIR(0)="SA^1:Earliest Report Date;2:Latest Report Date"
+4 SET DIR("A")="Sort Report By: "
+5 SET DIR("B")="Latest Report Date"
+6 DO ^DIR
+7 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y<0)
SET PRCAQUIT=1
GOTO SORTX
+8 SET PRCASORT=$SELECT(Y=2:"-1",1:"+1")
+9 ;
SORTX ;
+1 QUIT
+2 ;
SET(X,CNT,PRCAIEN) ;set up list manager screen array
+1 SET VALMCNT=VALMCNT+1
+2 SET ^TMP("PRCAMDA",$JOB,VALMCNT,0)=X
+3 SET ^TMP("PRCAMDA",$JOB,"IDX",VALMCNT,CNT)=""
+4 IF $GET(PRCAIEN)
IF $GET(^TMP("PRCAMDA",$JOB,CNT))=""
SET ^TMP("PRCAMDA",$JOB,CNT)=VALMCNT_U_PRCAIEN
+5 QUIT
+6 ;
EXP ; -- expand code to show additional details of the EOB record
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
