Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCAMDA1

PRCAMDA1.m

Go to the documentation of this file. 
  1. PRCAMDA1 ;ALB/TAZ - PRCA MDA WORKLIST SCREEN ;18-APR-2011
  1.  ;;4.5;Accounts Receivable;**275**;Mar 20, 1995;Build 72
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;DBIA #3820
  1.  ;
  1. EN ; -- main entry point for MDA Worklist
  1.  N PRCAEDT,PRCASDT,PRCASORT,PRCAQUIT,PRCASDV
  1.  N VALMBCK,VALMCNT,VALMHDR,VALMQUIT
  1.  D EN^VALM("PRCA MDA WORKLIST")
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  S VALMHDR(1)="Part A Inpatient"
  1.  S VALMHDR(2)=""
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  N DIC,DIRUT,DIROUT,DTOUT,DUOUT,X,Y,DIR,LN,PRCADIV
  1.  K ^TMP("PRCAMDA",$J),^TMP($J,"PRCAMDA")
  1.  S PRCAQUIT=0
  1.  ;
  1.  D DIV(.PRCASDV) ;Build list of Divisions (or all divisions)
  1.  I PRCAQUIT=1 S VALMQUIT="" G INITQ
  1.  ;
  1.  D DTR(.PRCASDT,.PRCAEDT) ;Get Worklist Dates
  1.  I PRCAQUIT=1 S VALMQUIT="" G INITQ
  1.  ;
  1.  D SORT(.PRCASORT) ;Get Worklist Sort Direction
  1.  I PRCAQUIT=1 S VALMQUIT="" G INITQ
  1.  ;
  1.  D BLD ;Build Arrays
  1.  ;
  1. INITQ ;
  1.  Q
  1.  ;
  1. BLD ; -- Build the Arrays
  1.  ;Build the DIV array
  1.  K ^TMP($J,"PRCAMDA","DIV")
  1.  S PRCAIEN=""
  1.  F  S PRCAIEN=$O(^PRCA(436.1,"AMDA",1,PRCAIEN),PRCASORT) Q:'PRCAIEN  D
  1.  . N PRCARDT,PRCAOK
  1.  . S PRCARDT=$$GET1^DIQ(436.1,PRCAIEN_", ",.1,"I") I PRCARDT>PRCAEDT!(PRCARDT<PRCASDT) Q  ;Not in Date Range
  1.  . S PRCADIV=$$GET1^DIQ(436.1,PRCAIEN_", ",1.03,"I") I 'PRCADIV S PRCADIV="99999"
  1.  . I PRCASDV,'$D(^TMP($J,"PRCAMDA","DIV",PRCADIV)) Q  ; Not a selected division
  1.  . S ^TMP($J,"PRCAMDA","DIV",PRCADIV,PRCAIEN)=""
  1.  ;
  1.  ; Build the List Array.
  1.  S PRCADIV="",(LN,VALMCNT)=0
  1.  F  S PRCADIV=$O(^TMP($J,"PRCAMDA","DIV",PRCADIV)) Q:'PRCADIV  D
  1.  . D SET("Division: "_$S(PRCADIV=99999:"Unknown",1:$P(^DG(40.8,PRCADIV,0),U,1)),LN+1)
  1.  . S PRCAIEN=""
  1.  . F  S PRCAIEN=$O(^TMP($J,"PRCAMDA","DIV",PRCADIV,PRCAIEN)) Q:'PRCAIEN  D
  1.  .. N PRCABN,PRCAFN,PRCAPN,PRCARS,LINEVAR
  1.  .. S PRCABN=$$GET1^DIQ(436.1,PRCAIEN_", ",.01,"I"),PRCAPN="Unknown Patient"
  1.  .. S PRCAFN=$$GET1^DIQ(436.1,PRCAIEN_", ",1.01,"I") I PRCAFN S PRCAPN=$$GET1^DIQ(399,PRCAFN_", ",.02,"E") ;DBIA #3820
  1.  .. S PRCARS=$$GET1^DIQ(436.1,PRCAIEN_", ",1.02,"I")=1 ;Only place asterisk on REVIEW IN PROCESS entries.
  1.  .. S LINEVAR=""
  1.  .. S LN=LN+1
  1.  .. S LINEVAR=$$SETFLD^VALM1(LN,LINEVAR,"NUMBER")
  1.  .. S LINEVAR=$$SETFLD^VALM1(PRCABN,LINEVAR,"BILL")
  1.  .. I PRCARS S LINEVAR=$$SETSTR^VALM1("*",LINEVAR,15,15)
  1.  .. S LINEVAR=$$SETFLD^VALM1(PRCAPN,LINEVAR,"PTNAME")
  1.  .. S LINEVAR=$$SETFLD^VALM1($$GET1^DIQ(436.1,PRCAIEN_", ",.03,"I"),LINEVAR,"SUBID")
  1.  .. S LINEVAR=$$SETFLD^VALM1(" "_$P($$FMTE^XLFDT($$GET1^DIQ(436.1,PRCAIEN_", ",.08,"I"),"7D"),"/",1),LINEVAR,"SYEAR")
  1.  .. S LINEVAR=$$SETFLD^VALM1(" "_$P($$FMTE^XLFDT($$GET1^DIQ(436.1,PRCAIEN_", ",.09,"I"),"7D"),"/",1),LINEVAR,"EYEAR")
  1.  .. S LINEVAR=$$SETFLD^VALM1($J($$GET1^DIQ(436.1,PRCAIEN_", ",.06,"I"),6),LINEVAR,"DEDSUB")
  1.  .. S LINEVAR=$$SETFLD^VALM1($J($$GET1^DIQ(436.1,PRCAIEN_", ",.07,"I"),6),LINEVAR,"DEDAVL")
  1.  .. S LINEVAR=$$SETFLD^VALM1($J($$FMTE^XLFDT($$GET1^DIQ(436.1,PRCAIEN_", ",.1,"I"),"2DZ"),8),LINEVAR,"RPTDT")
  1.  .. D SET(LINEVAR,LN,PRCAIEN)
  1. BLDQ ;
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K ^TMP("PRCAMDA",$J),^TMP($J,"PRCAMDA","DIV")
  1.  D CLEAN^VALM10
  1.  Q
  1.  ;
  1.  ;Output:
  1.  ;^TMP($J,"PRCAMDA","DIV",<div>) - List of selected divisions
  1.  ;PRCASDV - Selected division switch - 1 = Divisions selected, 0 = all divisions
  1. DIV(PRCASDV) ; Get Division
  1.  N DIC,Y,PRCA1ST
  1.  K ^TMP($J,"PRCAMDA","DIV")
  1.  S PRCA1ST=1
  1.  F  D  Q:(Y<0)!PRCAQUIT
  1.  . S DIC="^DG(40.8,",DIC(0)="AEQMN",DIC("A")="Select "_$S(PRCA1ST:"",1:" Another ")_"Division: "_$S(PRCA1ST:"All Divisions// ",1:"")
  1.  . D ^DIC
  1.  . K DIC
  1.  . I Y<0 W:PRCA1ST " All Divisions" S PRCASDV=0 Q
  1.  . I $D(DTOUT)!$D(DUOUT) S PRCAQUIT=1 Q
  1.  . S ^TMP($J,"PRCAMDA","DIV",+Y)="",PRCA1ST=0
  1.  ;
  1. DIVX ;
  1.  Q
  1.  ;
  1.  ;Output:
  1.  ;PRCASDT - Worklist Earliest Report Date
  1.  ;PRCAEDT - Worklist Latest Report Date
  1.  ;
  1. DTR(PRCASDT,PRCAEDT) ;date range
  1.  N %DT,DTOUT,DUOUT,X,Y
  1.  S %DT="AEX"
  1.  S %DT("A")="Select Earliest Report Date: ",%DT("B")="TODAY-7"
  1.  W ! D ^%DT ;K %DT
  1.  I $D(DTOUT)!$D(DUOUT)!(Y<0) S PRCAQUIT=1 G DTRX
  1.  S PRCASDT=+Y
  1.  S %DT="AEX"
  1.  S %DT("A")="Select Latest Report Date: ",%DT("B")="TODAY"
  1.  D ^%DT ;K %DT
  1.  I $D(DTOUT)!$D(DUOUT)!(Y<0) S PRCAQUIT=1 G DTRX
  1.  S PRCAEDT=+Y
  1.  ;
  1. DTRX ;
  1.  Q
  1.  ;
  1.  ;Output:
  1.  ;PRCASORT - Direction of report entries.
  1.  ;
  1. SORT(PRCASORT) ;
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  W !
  1.  S DIR(0)="SA^1:Earliest Report Date;2:Latest Report Date"
  1.  S DIR("A")="Sort Report By: "
  1.  S DIR("B")="Latest Report Date"
  1.  D ^DIR
  1.  I $D(DTOUT)!$D(DUOUT)!(Y<0) S PRCAQUIT=1 G SORTX
  1.  S PRCASORT=$S(Y=2:"-1",1:"+1")
  1.  ;
  1. SORTX ;
  1.  Q
  1.  ;
  1. SET(X,CNT,PRCAIEN) ;set up list manager screen array
  1.  S VALMCNT=VALMCNT+1
  1.  S ^TMP("PRCAMDA",$J,VALMCNT,0)=X
  1.  S ^TMP("PRCAMDA",$J,"IDX",VALMCNT,CNT)=""
  1.  I $G(PRCAIEN),$G(^TMP("PRCAMDA",$J,CNT))="" S ^TMP("PRCAMDA",$J,CNT)=VALMCNT_U_PRCAIEN
  1.  Q
  1.  ;
  1. EXP ; -- expand code to show additional details of the EOB record
  1.  S VALMBCK="R"
  1.  Q
  1.  ;