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

BAREDL02.m

Go to the documentation of this file. 
  1. BAREDL02 ; IHS/SD/LSL - AR DOWNLOAD FILE LIST ;
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
  1.  ;
  1.  ;;
  1.  D CLEAR^VALM1
  1. EN ;EP -- main entry point list template
  1.  D EN^VALM("BAR DWLD FILE LIST")
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. HDR ;EP -- header code
  1.  S VALMSG=$$VALMSG^AMCOUT
  1.  S VALMHDR(1)=$P($G(^BAREDI("1T",FLNUM,0)),"^")
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. INIT ;EP -- init variables and list array
  1.  S VALMCNT=40
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. HELP ;EP -- help code
  1.  S X="?"
  1.  D DISP^XQORM1,MSG^AMCOUT("",2,0,0)
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. EXIT ;EP -- exit code
  1.  D CLEAR^VALM1
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. EXPND ;EP -- expand code
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. RESET ;EP; -- code to rebuild array after action
  1.  I $D(VALMQUIT) S VALMBCK="Q" Q
  1.  D TERM^VALM0
  1.  S VALMBCK="R"
  1.  D INIT,HDR
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. GATHER(SUBF) ; -- SUBRTN to set data into array
  1.  ;
  1.  ; FILE - file (eg.Med 835)
  1.  ; SUBF - sub file (eg.Payor Information)
  1.  ;
  1.  S FLST=".01;.02;.03;.04;.05;.06;.07"
  1.  S FL06="90056.0106"
  1.  S FL02="90056.0102"
  1.  S FL=$S(FLNUM="90056.0101":FL02,FLNUM="90056.0105":FL06,1:"")
  1.  I FL="" D NODATA Q
  1.  S PAD(.01)=9
  1.  S PAD(.02)=33
  1.  S PAD(.03)=5
  1.  S PAD(.04)=8
  1.  S PAD(.05)=4
  1.  S PAD(.06)=4
  1.  S PAD(.07)=12
  1.  S LN=0
  1.  S D2=0
  1.  S RECN=""
  1.  S SPACE=" "
  1.  S BAREDL("A")="FILE,SUBF,D2"
  1.  K ^TMP($J,"RD"),LINE
  1.  S LAB="RD"
  1.  ;
  1.  ; Get record details for file
  1.  D ENPM^XBDIQ1(FL,BAREDL("A"),FLST,"^TMP($J,LAB,")
  1.  I '$D(^TMP($J,"RD")) D NODATA Q
  1.  ;
  1.  ; Create output array
  1.  F  S RECN=$O(^TMP($J,"RD",RECN)) Q:RECN=""  D
  1.  .S (LINE(RECN),FLDNM)=""
  1.  .F  S FLDNM=$O(^TMP($J,"RD",RECN,FLDNM)) Q:FLDNM=""  D
  1.  ..S DATA=^TMP($J,"RD",RECN,FLDNM)
  1.  ..I FLDNM=".01" S DATA=SPACE_DATA
  1.  ..S LINE(RECN)=LINE(RECN)_$$PAD(DATA,PAD(FLDNM))
  1.  ..S ^TMP($J,"LVL2",1,SUBF,RECN)=LINE(RECN)
  1.  ..S ^TMP($J,"LVL2","IDX",1,SUBF,RECN)=LINE(RECN)
  1.  ..Q
  1.  ; 
  1.  K LINE
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. NODATA ; No data to be reported
  1.  ;
  1.  S ^TMP($J,"LVL2",1,SUBF,1)="No data available"
  1.  S ^TMP($J,"LVL2","IDX",1,SUBF,1)="No data available"
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. GETITEM ; -- select item from list
  1.  K BARDR,^TMP($J,"LVL2")
  1.  S VALMLST=""
  1.  S VALMLST=$O(^TMP($J,"LVL1","IDX",VALMLST),-1)
  1.  D EN^VALM2(XQORNOD(0),"O")
  1.  I '$D(VALMY) Q
  1.  NEW SF,Z
  1.  S SF=0
  1.  F  S SF=$O(VALMY(SF)) Q:SF=""  D
  1.  . D GATHER(SF)
  1.  . S Z=""
  1.  . F  S Z=$O(^TMP($J,"LVL2","IDX",1,SF,Z)) Q:Z=""  D
  1.  .. Q:$G(^TMP($J,"LVL2","IDX",1,SF,Z))=""
  1.  .. S BARDR(Z)=^TMP($J,"LVL2","IDX",1,SF,Z)
  1.  .. S ^TMP($J,"FL",Z,0)=BARDR(Z)
  1.  .. S HDR=$G(^TMP($J,"FD",SF))
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. BROWSE(FILE) ;EP; -- called to browse help on screen
  1.  ; Called by AMCO HELP BROWSE (Browse Help Text) protocol
  1.  K ^TMP($J,"LVL2"),^TMP($J,"FL")
  1.  D GETITEM I '$D(BARDR) Q
  1.  ; Segment element details
  1.  I FL="90056.0102" D
  1.  . S LSTFILE="BAR Segment Element Details"
  1.  . D EN^BAREDL03(HDR,LSTFILE)
  1.  I FL="90056.0106" D
  1.  . S LSTFILE="BAR Table ID Details"
  1.  . D EN^BAREDL03(HDR,LSTFILE)
  1.  K BARDR
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. EDIT ;EP; -- called to edit document
  1.  ; called by AMCO HELP EDIT (Add/Edit Help Text) protocol
  1.  ; called by AMCO DEV HELP EDIT (Add/Edit Help Text) protocol
  1.  NEW AMCON,AMCODR,DIE,DR,DA,DIC,DLAYGO
  1.  S Y=$$READ^AMCOUT("SBO^ADD:ADD New Document;EDIT:EDIT Existing Document","Select Action")
  1.  I Y="ADD" D  Q
  1.  . S (DIC,DLAYGO)=9002090.45
  1.  . S DIC(0)="AEMLQZ"
  1.  . D ^DIC
  1.  . Q:Y<1
  1.  . S DIE="^AMCODOC("
  1.  . S DA=+Y
  1.  . S DR=".01:999"
  1.  . D ^DIE
  1.  ;
  1.  D GETITEM
  1.  I '$D(AMCODR) Q
  1.  S AMCON=0
  1.  F  S AMCON=$O(AMCODR(AMCON)) Q:'AMCON  D
  1.  . S DIE="^AMCODOC("
  1.  . S DA=AMCODR(AMCON)
  1.  . S DR=".01:999"
  1.  . D ^DIE
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. PRINT ;EP; call to print help documents on paper
  1.  ; Called by AMCO HELP PRINT (Print Help Text) protocol
  1.  NEW AMCODR,%ZIS,POP
  1.  D GETITEM
  1.  I '$D(AMCODR) Q
  1.  S %ZIS="QP"
  1.  D ^%ZIS
  1.  Q:POP
  1.  I $D(IO("Q")) D  Q
  1.  . S ZTRTN="PRINT^AMCOHL1"
  1.  . S ZTDESC="OB HELP GUIDE"
  1.  . S ZTSAVE("AMCODR(")=""
  1.  . K IO("Q")
  1.  . D ^%ZTLOAD
  1.  . K ZTSK
  1.  . D HOME^%ZIS
  1.  D CLEAR^VALM1,PRINT^AMCOHL1,RESET
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. PAD(D,L) ; -- SUBRTN to pad length of data
  1.  ; -- D=data L=length
  1.  Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
  1.  ; *********************************************************************
  1.  ;
  1. SP(N) ; -- SUBRTN to pad N number of spaces
  1.  Q $$PAD(" ",N)