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

IBOHLSE.m

Go to the documentation of this file. 
  1. IBOHLSE ;ALB/BAA - IB HELD CHARGES LIST MANAGER ;08-SEP-2015
  1.  ;;2.0;INTEGRATED BILLING;**554**;21-MAR-94;Build 81
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1. EN ; -- main entry point for HELD CHARGES EXPAND
  1.  ; add code to do filters here
  1.  ;
  1.  D EN^VALM("IB HELD CHARGES EXPAND")
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  ;
  1.  S VALM("TITLE")=" Expanded Held Charges"
  1.  S XQORM("B")="QUIT"
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  ; input - none
  1.  ; output ^TMP($J,"IBOHLSE")
  1.  N DFN,CNT,NAME,IBIEN,REC,CLINIC,LST
  1.  S REC=^TMP($J,"IBOHLSE")
  1.  S DFN=$P(REC,U,1),CNT=$P(REC,U,2)
  1.  S NAME=$P(REC,U,3),IBIEN=$P(REC,U,4)
  1.  S LST=$P(REC,U,5),CLINIC=$P(REC,U,6)
  1.  D BLD
  1.  Q
  1.  ;
  1. BLD ; build data to display
  1.  N CNT,SS,LINE,XX,RX,GMT,IB0,IB1,PATIEN,XX
  1.  N EADAT,EAWHO,LUDAT,LUWHO
  1.  S (CNT,VALMCNT)=0
  1.  S IB0=^IB(IBIEN,0)
  1.  S IB1=^IB(IBIEN,1)
  1.  S SS=$$GET1^DIQ(2,DFN,.09)
  1.  ;
  1.  D FULL^VALM1
  1.  D SET^VALM10(1,"PATIENT : "_NAME_" - "_SS,"")
  1.  ;
  1.  D SET^VALM10(2,"TYPE : "_$$GET1^DIQ(350.1,$P(IB0,U,3),.01),"")
  1.  ;
  1.  D SET^VALM10(3,"RESULTING FROM : "_$P(IB0,U,4),"")
  1.  ;
  1.  S LINE="",LINE=$$SETL(LINE,$$GET1^DIQ(350.21,$P(IB0,U,5),.01),"STATUS : ",1,38)
  1.  S LINE=$$SETL(LINE,$$FMTE^XLFDT($P(IB0,U,17),"2DZ"),"EVENT DATE : ",40,38)
  1.  D SET^VALM10(4,LINE,"")
  1.  ;
  1.  S LINE="",LINE=$$SETL(LINE,$P(IB0,U,9),"PARENT : ",1,38)
  1.  S LINE=$$SETL(LINE,$P(IB0,U,7),"CHARGE : ",40,38)
  1.  D SET^VALM10(5,LINE,"")
  1.  ;
  1.  D SET^VALM10(6,"INSTITUTION : "_$$GET1^DIQ(4,$P(IB0,U,13),.01)_" : "_LST_" - "_CLINIC,"")
  1.  ;
  1.  D SET^VALM10(7,"BILLED : "_$$FMTE^XLFDT($P(IB0,U,14),"2DZ")_" - "_$$FMTE^XLFDT($P(IB0,U,15),"2DZ"),"")
  1.  ;
  1.  S LINE="",LINE=$$SETL(LINE,$$GET1^DIQ(4,$P(IB0,U,13),.01),"AR BILL # : ",1,38)
  1.  S LINE=$$SETL(LINE,$$FMTE^XLFDT($P(IB0,U,18),"2DZ"),"LAST BILLED : ",40,38)
  1.  D SET^VALM10(8,LINE,"")
  1.  ;
  1.  D SET^VALM10(9,"IB COPAY TRANS # : "_$$GET1^DIQ(354.71,$P(IB0,U,19),.01),"")
  1.  D SET^VALM10(10,"CLINIC STOP : "_$$GET1^DIQ(352.5,$P(IB0,U,20),.01),"")
  1.  ;
  1.  S GMT=$P(IB0,U,21)
  1.  D SET^VALM10(11,"GMT RELATED : "_$S(GMT=1:"Yes",1:"No"),"")
  1.  D SET^VALM10(12,"PFSS ACCT REF : "_$$GET1^DIQ(375,$P(IB0,U,22),.01),"")
  1.  ;
  1.  S EAWHO=$$GET1^DIQ(200,$P(IB1,U,1),.01)
  1.  S EADAT=$$FMTE^XLFDT($P(IB1,U,2),"2DZ")
  1.  D SET^VALM10(13,"ENTRY ADDED : "_EAWHO_"     "_EADAT,"")
  1.  ;
  1.  S LUWHO=$$GET1^DIQ(200,$P(IB1,U,3),.01)
  1.  S LUDAT=$$FMTE^XLFDT($P(IB1,U,4),"2DZ")
  1.  D SET^VALM10(14,"LAST UPDATED : "_LUWHO_"     "_LUDAT,"")
  1.  ;
  1.  D SET^VALM10(15,"CHAMPVA ADM DATE : "_$$FMTE^XLFDT($P(IB1,U,5),"2DZ"),"")
  1.  D SET^VALM10(16,"ON HOLD DATE : "_$$FMTE^XLFDT($P(IB1,U,6),"2DZ"),"")
  1.  D SET^VALM10(17,"HOLD-REVIEW DATE : "_$$FMTE^XLFDT($P(IB1,U,7),"2DZ"),"")
  1.  S VALMBCK="R",VALMBG=1,VALMCNT=16
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  N X
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  ;K ^TMP($J)
  1.  D ^%ZISC
  1.  I 
  1.  S VALMBCK="R" Q
  1.  Q
  1.  ;
  1. SETL(LINE,DATA,LABEL,COL,LNG) ; Creates a line of data to be set into the body
  1.  ; of the worklist
  1.  ; Input: LINE - Current line being created
  1.  ; DATA - Information to be added to the end of the current line
  1.  ; LABEL - Label to describe the information being added
  1.  ; COL - Column position in line to add information add
  1.  ; LNG - Maximum length of data information to include on the line
  1.  ; Returns: Line updated with added information
  1.  ;S LINE=LINE_$J("",(COL-$L(LABEL)-$L(LINE)))_LABEL_$E(DATA,1,LNG)
  1.  N NEW
  1.  S NEW=LABEL_$E(DATA,1,LNG)
  1.  S $E(LINE,COL)=NEW
  1.  Q LINE