PRCAMDA2 ;ALB/TAZ - PRCA MDA MANAGEMENT WORKLIST SCREEN ;26-APR-2011
;;4.5;Accounts Receivable;**275**;Mar 20, 1995;Build 72
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; Need Integration Agreement with IB to call into TPJI. We are using IB variables to make sure that everything works.
TPJI ;Third Party joint Inquiry - IA-???
N DFN,PRCAIEN,IBIFN,IBNOTPJI
D SEL(.PRCADA,1)
S PRCAIEN=+$G(PRCADA(+$O(PRCADA(0))))
I 'PRCAIEN G TPJIQ
S PRCAFN=$P($G(^PRCA(436.1,PRCAIEN,1)),U,1) I PRCAFN S DFN=$P(^PRCA(430,PRCAFN,0),U,7)
I '$G(DFN)!'PRCAFN G TPJIQ
S IBIFN=PRCAFN,IBNOTPJI=1
D EN^VALM("IBJT CLAIM INFO")
K:$D(IBFASTXT) IBFASTXT
TPJIQ S VALMBCK="R"
Q
;
CMNT ; enter MDA comments - entry point from MDA Worklist screen
; we need to select an entry from the list and set PRCAFN
N DA,DD,DIC,DIK,DLAYGO,X,Y,PRCADA,PRCAFN,MRAFLG
S MRAFLG=1
D SEL(.PRCADA,1) S:$O(PRCADA(0)) PRCAIEN=+PRCADA($O(PRCADA(0))) I '$G(PRCAIEN) G CMNTQ
D EN^VALM("PRCA MDA COMMENTS")
D BLD^PRCAMDA1
;
CMNTQ ;
S VALMBCK="R"
Q
;
SEL(PRCADA,ONE) ; Select entry(s) from list
; PRCADA = array returned if selections made
; PRCADA(n)=ien of entry selected (file 436.1)
; ONE = if set to 1, only one selection can be made at a time
N VALMY
K PRCADA
D FULL^VALM1
D EN^VALM2("",$S('$G(ONE):"",1:"S"))
S PRCADA=0 F S PRCADA=$O(VALMY(PRCADA)) Q:'PRCADA S PRCADA(PRCADA)=$P($G(^TMP("PRCAMDA",$J,+PRCADA)),U,2,6)
Q
;
STATUS ; change MDA review status
N DA,DIE,DR,PRCADA,PRCAFN,SEL
D SEL(.PRCADA,1) S:$O(PRCADA(0)) PRCAIEN=+PRCADA($O(PRCADA(0))) G:'$G(PRCAIEN) STATUSX
L +^PRCA(436.1,PRCAIEN):3 I '$T W !,*7,"Sorry, another user currently editing this entry." D PAUSE^VALM1 G STATUSX
D STATUS1
STATUSX ;
;update list manager display
L -^PRCA(436.1,PRCAIEN)
D BLD^PRCAMDA1
S VALMBCK="R"
Q
;
STATUS1 ; Entry point from comments section
N PRCASTAT,PRCATEXT
; make sure this entry is not locked already
; Prompt for status change
W !
S DIR(0)="436.1,1.02",DIR("B")="REVIEW IN PROCESS"
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) G STATUS1X
M PRCASTAT=Y
I PRCASTAT=3 D
. W !
. S DIR(0)="Y",DIR("A")="Are you sure you want to remove this entry from the worklist",DIR("B")="NO"
. D ^DIR K DIR
. I $D(DTOUT)!$D(DUOUT)!'Y S PRCASTAT="" Q
. ; Enter comment for removal from worklist
. S PRCATEXT(1)="Review completed and entry removed from worklist."
. S DA(1)=PRCAIEN
. K DO S DIC="^PRCA(436.1,"_DA(1)_",2,",DIC(0)="L",X=$$NOW^XLFDT,DLAYGO=436.12
. D FILE^DICN
. S DA=+Y I DA'>0 Q
. D WP^DIE(436.12,DA_","_DA(1)_",",2,,"PRCATEXT")
. K DIC
I PRCASTAT'="" S DIE=436.1,DA=PRCAIEN,DR="1.02///"_PRCASTAT(0) D ^DIE,CLEAN^DILF
STATUS1X ;
Q
;
MCOM(PRCABN,PRCALN) ; MDA (Medicare Deductible Alert) Comments
; INPUTS: IEN for 430
; : LIST MAN LINE COUNTER (Pass by Reference)
; OUTPUT: VALMAR
; PRCA*4.5*275 BI
; INTEGRATION CONTROL REGISTRATION is contained in DBIA #5696.
;
N PRCADATE,PRCAIMDA,PRCAZ,PRCACMLN,PRCACTL,PRCAMCOM
S PRCACTL=1
S PRCAMCOM(0)=0
I '$G(PRCABN) Q
S PRCAIMDA=""
F S PRCAIMDA=$O(^PRCA(436.1,"C",PRCABN,PRCAIMDA)) Q:PRCAIMDA="" D
. D MCOM2(PRCAIMDA,.PRCALN,PRCACTL)
D:PRCACTL=1 MDACMTS
Q
MCOM2(PRCAIMDA,PRCALN,PRCACTL) ; MDA (Medicare Deductible Alert) Comments
; INPUTS: IEN for 436.1
; : LIST MAN LINE COUNTER (Pass by Reference)
; OUTPUT: VALMAR
; PRCA*4.5*275 BI
;
S PRCACTL=$G(PRCACTL,0)
I PRCACTL=0 N PRCACMLN,PRCADATE,PRCAZ,PRCAMCOM S PRCAMCOM(0)=0
I 'PRCAIMDA Q
I $D(^PRCA(436.1,PRCAIMDA,2))'>1 Q
; Loop through all available MDA comments.
S PRCADATE="" F S PRCADATE=$O(^PRCA(436.1,PRCAIMDA,2,"B",PRCADATE),-1) Q:PRCADATE="" D
. S PRCAMCOM(0)=PRCAMCOM(0)+1
. S PRCAZ=$O(^PRCA(436.1,PRCAIMDA,2,"B",PRCADATE,""))
. S PRCAIMDA(0)=$G(^PRCA(436.1,PRCAIMDA,2,PRCAZ,0))
. S PRCAIMDA(0,0)=$G(^PRCA(436.1,PRCAIMDA,2,PRCAZ,1,0))
. S PRCAMCOM(PRCAMCOM(0))=$$GET1^DIQ(200,$P(PRCAIMDA(0),U,2),.01)_U
. S PRCAMCOM(PRCAMCOM(0))=PRCAMCOM(PRCAMCOM(0))_$$FMTE^XLFDT(PRCADATE,"2Z")_U
. S PRCAMCOM(PRCAMCOM(0))=PRCAMCOM(PRCAMCOM(0))_$$FMTE^XLFDT($P(PRCAIMDA(0),U,3),"2Z")
. ; Loop through the comment lines.
. S PRCAMCOM(PRCAMCOM(0),0)=$P(PRCAIMDA(0,0),U,4)
. F PRCACMLN=1:1:PRCAMCOM(PRCAMCOM(0),0) D
.. S PRCAMCOM(PRCAMCOM(0),PRCACMLN)=^PRCA(436.1,PRCAIMDA,2,PRCAZ,1,PRCACMLN,0)
I PRCACTL=0 D MDACMTS
Q
;
MDACMTS ; Check for MDA comments, Load for List Manager Screen IB*2.0*447 BI
; Input: VALMAR
; PRCALN
; Output: @VALMAR Array
;
N PRCASTR,PRCACCNT,PRCAK
N DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,%,I,X,Z
I PRCAMCOM(0)=0 Q
;
; Set up the header for the MDA comments section.
S PRCALN=PRCALN+1 D SET^VALM10(PRCALN,"")
S PRCASTR=""
S PRCASTR=$$SETSTR^VALM1("MEDICARE DEDUCTIBLE ALERT WORKLIST COMMENTS",PRCASTR,25,54)
S PRCALN=PRCALN+1 D SET^VALM10(PRCALN,PRCASTR)
S PRCASTR=""
S PRCASTR=$$SETSTR^VALM1("-------------------------------------------",PRCASTR,25,54)
S PRCALN=PRCALN+1 D SET^VALM10(PRCALN,PRCASTR)
;
; Loop through all available MDA comments.
F PRCACCNT=1:1:PRCAMCOM(0) D
. S PRCASTR=""
. S PRCASTR=$$SETSTR^VALM1($P(PRCAMCOM(PRCACCNT),U,2),PRCASTR,14,8)
. S PRCASTR=$$SETSTR^VALM1($J("Entered by "_$P(PRCAMCOM(PRCACCNT),U,1),54),PRCASTR,25,54)
. S PRCALN=PRCALN+1 D SET^VALM10(PRCALN,PRCASTR)
. K ^UTILITY($J)
. F PRCACMLN=1:1:PRCAMCOM(PRCACCNT,0) D
.. S X=PRCAMCOM(PRCACCNT,PRCACMLN) I X'="" S DIWL=1,DIWR=54,DIWF="" D ^DIWP
. I $D(^UTILITY($J,"W")) S PRCAK=0 F S PRCAK=$O(^UTILITY($J,"W",1,PRCAK)) Q:'PRCAK D
.. S PRCASTR=""
.. S PRCASTR=$$SETSTR^VALM1($G(^UTILITY($J,"W",1,PRCAK,0)),PRCASTR,25,54)
.. S PRCALN=PRCALN+1 D SET^VALM10(PRCALN,PRCASTR)
. I $P(PRCAMCOM(PRCACCNT),U,3)'="" D
.. S PRCASTR=""
.. S PRCASTR=$$SETSTR^VALM1("Follow Up Date: "_$P(PRCAMCOM(PRCACCNT),U,3),PRCASTR,14,24)
.. S PRCALN=PRCALN+1 D SET^VALM10(PRCALN,PRCASTR)
. S PRCALN=PRCALN+1 D SET^VALM10(PRCALN,"")
. K ^UTILITY($J,"W")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAMDA2 6027 printed Oct 16, 2024@17:41:16 Page 2
PRCAMDA2 ;ALB/TAZ - PRCA MDA MANAGEMENT WORKLIST SCREEN ;26-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 ;
+4 ; Need Integration Agreement with IB to call into TPJI. We are using IB variables to make sure that everything works.
TPJI ;Third Party joint Inquiry - IA-???
+1 NEW DFN,PRCAIEN,IBIFN,IBNOTPJI
+2 DO SEL(.PRCADA,1)
+3 SET PRCAIEN=+$GET(PRCADA(+$ORDER(PRCADA(0))))
+4 IF 'PRCAIEN
GOTO TPJIQ
+5 SET PRCAFN=$PIECE($GET(^PRCA(436.1,PRCAIEN,1)),U,1)
IF PRCAFN
SET DFN=$PIECE(^PRCA(430,PRCAFN,0),U,7)
+6 IF '$GET(DFN)!'PRCAFN
GOTO TPJIQ
+7 SET IBIFN=PRCAFN
SET IBNOTPJI=1
+8 DO EN^VALM("IBJT CLAIM INFO")
+9 if $DATA(IBFASTXT)
KILL IBFASTXT
TPJIQ SET VALMBCK="R"
+1 QUIT
+2 ;
CMNT ; enter MDA comments - entry point from MDA Worklist screen
+1 ; we need to select an entry from the list and set PRCAFN
+2 NEW DA,DD,DIC,DIK,DLAYGO,X,Y,PRCADA,PRCAFN,MRAFLG
+3 SET MRAFLG=1
+4 DO SEL(.PRCADA,1)
if $ORDER(PRCADA(0))
SET PRCAIEN=+PRCADA($ORDER(PRCADA(0)))
IF '$GET(PRCAIEN)
GOTO CMNTQ
+5 DO EN^VALM("PRCA MDA COMMENTS")
+6 DO BLD^PRCAMDA1
+7 ;
CMNTQ ;
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
SEL(PRCADA,ONE) ; Select entry(s) from list
+1 ; PRCADA = array returned if selections made
+2 ; PRCADA(n)=ien of entry selected (file 436.1)
+3 ; ONE = if set to 1, only one selection can be made at a time
+4 NEW VALMY
+5 KILL PRCADA
+6 DO FULL^VALM1
+7 DO EN^VALM2("",$SELECT('$GET(ONE):"",1:"S"))
+8 SET PRCADA=0
FOR
SET PRCADA=$ORDER(VALMY(PRCADA))
if 'PRCADA
QUIT
SET PRCADA(PRCADA)=$PIECE($GET(^TMP("PRCAMDA",$JOB,+PRCADA)),U,2,6)
+9 QUIT
+10 ;
STATUS ; change MDA review status
+1 NEW DA,DIE,DR,PRCADA,PRCAFN,SEL
+2 DO SEL(.PRCADA,1)
if $ORDER(PRCADA(0))
SET PRCAIEN=+PRCADA($ORDER(PRCADA(0)))
if '$GET(PRCAIEN)
GOTO STATUSX
+3 LOCK +^PRCA(436.1,PRCAIEN):3
IF '$TEST
WRITE !,*7,"Sorry, another user currently editing this entry."
DO PAUSE^VALM1
GOTO STATUSX
+4 DO STATUS1
STATUSX ;
+1 ;update list manager display
+2 LOCK -^PRCA(436.1,PRCAIEN)
+3 DO BLD^PRCAMDA1
+4 SET VALMBCK="R"
+5 QUIT
+6 ;
STATUS1 ; Entry point from comments section
+1 NEW PRCASTAT,PRCATEXT
+2 ; make sure this entry is not locked already
+3 ; Prompt for status change
+4 WRITE !
+5 SET DIR(0)="436.1,1.02"
SET DIR("B")="REVIEW IN PROCESS"
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO STATUS1X
+8 MERGE PRCASTAT=Y
+9 IF PRCASTAT=3
Begin DoDot:1
+10 WRITE !
+11 SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to remove this entry from the worklist"
SET DIR("B")="NO"
+12 DO ^DIR
KILL DIR
+13 IF $DATA(DTOUT)!$DATA(DUOUT)!'Y
SET PRCASTAT=""
QUIT
+14 ; Enter comment for removal from worklist
+15 SET PRCATEXT(1)="Review completed and entry removed from worklist."
+16 SET DA(1)=PRCAIEN
+17 KILL DO
SET DIC="^PRCA(436.1,"_DA(1)_",2,"
SET DIC(0)="L"
SET X=$$NOW^XLFDT
SET DLAYGO=436.12
+18 DO FILE^DICN
+19 SET DA=+Y
IF DA'>0
QUIT
+20 DO WP^DIE(436.12,DA_","_DA(1)_",",2,,"PRCATEXT")
+21 KILL DIC
End DoDot:1
+22 IF PRCASTAT'=""
SET DIE=436.1
SET DA=PRCAIEN
SET DR="1.02///"_PRCASTAT(0)
DO ^DIE
DO CLEAN^DILF
STATUS1X ;
+1 QUIT
+2 ;
MCOM(PRCABN,PRCALN) ; MDA (Medicare Deductible Alert) Comments
+1 ; INPUTS: IEN for 430
+2 ; : LIST MAN LINE COUNTER (Pass by Reference)
+3 ; OUTPUT: VALMAR
+4 ; PRCA*4.5*275 BI
+5 ; INTEGRATION CONTROL REGISTRATION is contained in DBIA #5696.
+6 ;
+7 NEW PRCADATE,PRCAIMDA,PRCAZ,PRCACMLN,PRCACTL,PRCAMCOM
+8 SET PRCACTL=1
+9 SET PRCAMCOM(0)=0
+10 IF '$GET(PRCABN)
QUIT
+11 SET PRCAIMDA=""
+12 FOR
SET PRCAIMDA=$ORDER(^PRCA(436.1,"C",PRCABN,PRCAIMDA))
if PRCAIMDA=""
QUIT
Begin DoDot:1
+13 DO MCOM2(PRCAIMDA,.PRCALN,PRCACTL)
End DoDot:1
+14 if PRCACTL=1
DO MDACMTS
+15 QUIT
MCOM2(PRCAIMDA,PRCALN,PRCACTL) ; MDA (Medicare Deductible Alert) Comments
+1 ; INPUTS: IEN for 436.1
+2 ; : LIST MAN LINE COUNTER (Pass by Reference)
+3 ; OUTPUT: VALMAR
+4 ; PRCA*4.5*275 BI
+5 ;
+6 SET PRCACTL=$GET(PRCACTL,0)
+7 IF PRCACTL=0
NEW PRCACMLN,PRCADATE,PRCAZ,PRCAMCOM
SET PRCAMCOM(0)=0
+8 IF 'PRCAIMDA
QUIT
+9 IF $DATA(^PRCA(436.1,PRCAIMDA,2))'>1
QUIT
+10 ; Loop through all available MDA comments.
+11 SET PRCADATE=""
FOR
SET PRCADATE=$ORDER(^PRCA(436.1,PRCAIMDA,2,"B",PRCADATE),-1)
if PRCADATE=""
QUIT
Begin DoDot:1
+12 SET PRCAMCOM(0)=PRCAMCOM(0)+1
+13 SET PRCAZ=$ORDER(^PRCA(436.1,PRCAIMDA,2,"B",PRCADATE,""))
+14 SET PRCAIMDA(0)=$GET(^PRCA(436.1,PRCAIMDA,2,PRCAZ,0))
+15 SET PRCAIMDA(0,0)=$GET(^PRCA(436.1,PRCAIMDA,2,PRCAZ,1,0))
+16 SET PRCAMCOM(PRCAMCOM(0))=$$GET1^DIQ(200,$PIECE(PRCAIMDA(0),U,2),.01)_U
+17 SET PRCAMCOM(PRCAMCOM(0))=PRCAMCOM(PRCAMCOM(0))_$$FMTE^XLFDT(PRCADATE,"2Z")_U
+18 SET PRCAMCOM(PRCAMCOM(0))=PRCAMCOM(PRCAMCOM(0))_$$FMTE^XLFDT($PIECE(PRCAIMDA(0),U,3),"2Z")
+19 ; Loop through the comment lines.
+20 SET PRCAMCOM(PRCAMCOM(0),0)=$PIECE(PRCAIMDA(0,0),U,4)
+21 FOR PRCACMLN=1:1:PRCAMCOM(PRCAMCOM(0),0)
Begin DoDot:2
+22 SET PRCAMCOM(PRCAMCOM(0),PRCACMLN)=^PRCA(436.1,PRCAIMDA,2,PRCAZ,1,PRCACMLN,0)
End DoDot:2
End DoDot:1
+23 IF PRCACTL=0
DO MDACMTS
+24 QUIT
+25 ;
MDACMTS ; Check for MDA comments, Load for List Manager Screen IB*2.0*447 BI
+1 ; Input: VALMAR
+2 ; PRCALN
+3 ; Output: @VALMAR Array
+4 ;
+5 NEW PRCASTR,PRCACCNT,PRCAK
+6 NEW DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,%,I,X,Z
+7 IF PRCAMCOM(0)=0
QUIT
+8 ;
+9 ; Set up the header for the MDA comments section.
+10 SET PRCALN=PRCALN+1
DO SET^VALM10(PRCALN,"")
+11 SET PRCASTR=""
+12 SET PRCASTR=$$SETSTR^VALM1("MEDICARE DEDUCTIBLE ALERT WORKLIST COMMENTS",PRCASTR,25,54)
+13 SET PRCALN=PRCALN+1
DO SET^VALM10(PRCALN,PRCASTR)
+14 SET PRCASTR=""
+15 SET PRCASTR=$$SETSTR^VALM1("-------------------------------------------",PRCASTR,25,54)
+16 SET PRCALN=PRCALN+1
DO SET^VALM10(PRCALN,PRCASTR)
+17 ;
+18 ; Loop through all available MDA comments.
+19 FOR PRCACCNT=1:1:PRCAMCOM(0)
Begin DoDot:1
+20 SET PRCASTR=""
+21 SET PRCASTR=$$SETSTR^VALM1($PIECE(PRCAMCOM(PRCACCNT),U,2),PRCASTR,14,8)
+22 SET PRCASTR=$$SETSTR^VALM1($JUSTIFY("Entered by "_$PIECE(PRCAMCOM(PRCACCNT),U,1),54),PRCASTR,25,54)
+23 SET PRCALN=PRCALN+1
DO SET^VALM10(PRCALN,PRCASTR)
+24 KILL ^UTILITY($JOB)
+25 FOR PRCACMLN=1:1:PRCAMCOM(PRCACCNT,0)
Begin DoDot:2
+26 SET X=PRCAMCOM(PRCACCNT,PRCACMLN)
IF X'=""
SET DIWL=1
SET DIWR=54
SET DIWF=""
DO ^DIWP
End DoDot:2
+27 IF $DATA(^UTILITY($JOB,"W"))
SET PRCAK=0
FOR
SET PRCAK=$ORDER(^UTILITY($JOB,"W",1,PRCAK))
if 'PRCAK
QUIT
Begin DoDot:2
+28 SET PRCASTR=""
+29 SET PRCASTR=$$SETSTR^VALM1($GET(^UTILITY($JOB,"W",1,PRCAK,0)),PRCASTR,25,54)
+30 SET PRCALN=PRCALN+1
DO SET^VALM10(PRCALN,PRCASTR)
End DoDot:2
+31 IF $PIECE(PRCAMCOM(PRCACCNT),U,3)'=""
Begin DoDot:2
+32 SET PRCASTR=""
+33 SET PRCASTR=$$SETSTR^VALM1("Follow Up Date: "_$PIECE(PRCAMCOM(PRCACCNT),U,3),PRCASTR,14,24)
+34 SET PRCALN=PRCALN+1
DO SET^VALM10(PRCALN,PRCASTR)
End DoDot:2
+35 SET PRCALN=PRCALN+1
DO SET^VALM10(PRCALN,"")
+36 KILL ^UTILITY($JOB,"W")
End DoDot:1
+37 QUIT
