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

IBJPC2.m

Go to the documentation of this file. 
  1. IBJPC2 ;ALB/FA - IBJP HCSR Wards Parameter Screen ;17-JUL-2014
  1.  ;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;;
  1.  ;
  1. EN ;EP
  1.  ; Main entry point for IBJP HCSR PARAMETERS
  1.  D EN^VALM("IBJP HCSR PARAMETERS")
  1.  Q
  1.  ;
  1. HDR ;EP
  1.  ; Header code
  1.  S VALMHDR(1)="Only authorized persons may edit this data."
  1.  Q
  1.  ;
  1. INIT ;EP
  1.  ; Initialize variables and list array
  1.  K ^TMP("IBJPC2",$J)
  1.  D BLD
  1.  Q
  1.  ;
  1. BLD ; Build screen array, no variables required for input
  1.  N IBLN,IBTRKR62,TEXT
  1.  S IBTRKR62=$G(^IBE(350.9,1,62))                ; IB*2.0*517 added line
  1.  S IBLN=$$SETTEXT("",1,1)
  1.  S TEXT="Health Care Services Review (HCSR) Parameters"
  1.  S IBLN=$$SETTEXT(TEXT,IBLN,17,1)
  1.  S TEXT=$J("CPAC Future Appointments Search: ",57)_$J($P(IBTRKR62,U,13),4)_" days"
  1.  S IBLN=$$SETTEXT(TEXT,IBLN,1)
  1.  S TEXT=$J("CPAC Future Admissions Search: ",57)_$J($P(IBTRKR62,U,2),4)_" days"
  1.  S IBLN=$$SETTEXT(TEXT,IBLN,1)
  1.  S TEXT=$J("CPAC Past Appointments Search: ",57)_$J($P(IBTRKR62,U,3),4)_" days"
  1.  S IBLN=$$SETTEXT(TEXT,IBLN,1)
  1.  S TEXT=$J("CPAC Past Admissions Search: ",57)_$J($P(IBTRKR62,U,4),4)_" days"
  1.  S IBLN=$$SETTEXT(TEXT,IBLN,1)
  1.  S TEXT=$J("TRICARE/CHAMPVA Future Appointments Search: ",57)_$J($P(IBTRKR62,U,5),4)_" days"
  1.  S IBLN=$$SETTEXT(TEXT,IBLN,1)
  1.  S TEXT=$J("TRICARE/CHAMPVA Future Admissions Search: ",57)_$J($P(IBTRKR62,U,6),4)_" days"
  1.  S IBLN=$$SETTEXT(TEXT,IBLN,1)
  1.  S TEXT=$J("TRICARE/CHAMPVA Past Appointments Search: ",57)_$J($P(IBTRKR62,U,7),4)_" days"
  1.  S IBLN=$$SETTEXT(TEXT,IBLN,1)
  1.  S TEXT=$J("TRICARE/CHAMPVA Past Admissions Search: ",57)_$J($P(IBTRKR62,U,8),4)_" days"
  1.  S IBLN=$$SETTEXT(TEXT,IBLN,1)
  1.  S TEXT=$J("Inquiry can be Triggered for Appointment: ",57)_$J($P(IBTRKR62,U,10),4)_" days"
  1.  S IBLN=$$SETTEXT(TEXT,IBLN,1)
  1.  S TEXT=$J("Inquiry can be Triggered for Admission: ",57)_$J($P(IBTRKR62,U,11),4)_" days"
  1.  S IBLN=$$SETTEXT(TEXT,IBLN,1)
  1.  S TEXT=$J("Days to wait to purge entry on HCSR Response: ",57)_$J($P(IBTRKR62,U,12),4)_" days"
  1.  S IBLN=$$SETTEXT(TEXT,IBLN,1)
  1.  S TEXT=$J("Clinics Included In the Search: ",57)_$J(+$P($G(^IBE(350.9,1,63,0)),U,4),4)
  1.  S IBLN=$$SETTEXT(TEXT,IBLN,1)
  1.  S TEXT=$J("Wards Included In the Search: ",57)_$J(+$P($G(^IBE(350.9,1,64,0)),U,4),4)
  1.  S IBLN=$$SETTEXT(TEXT,IBLN,1)
  1.  S TEXT=$J("Insurance Companies Included In the Appointments Search: ",57)_$J(+$P($G(^IBE(350.9,1,65,0)),U,4),4)
  1.  S IBLN=$$SETTEXT(TEXT,IBLN,1)
  1.  S TEXT=$J("Insurance Companies Included In the Admissions Search: ",57)_$J(+$P($G(^IBE(350.9,1,66,0)),U,4),4)
  1.  S IBLN=$$SETTEXT(TEXT,IBLN,1)
  1.  S (IBLN,VALMCNT)=IBLN-1
  1.  Q
  1.  ;
  1. SETTEXT(TEXT,LN,COL,RV) ; Sets a line of text into the body of the template
  1.  ; Input:   TEXT            - Text to be displayed
  1.  ;          LN              - Body line to display text on
  1.  ;          COL             - Column to begin display the text in
  1.  ;          RV              - 1 - Set Video Control Characters. Null Otherwise
  1.  ;          ^TMP("IBJPC2")  - Current global array of body display lines
  1.  ; Output:  ^TMP("IBJPC2")  - Updated global array of body display lines
  1.  ; Returns: LN              - Next body line after the one just set
  1.  N IBY
  1.  S IBY=" "_TEXT_" "
  1.  D SET1(IBY,LN,COL,$L(IBY),$G(RV))
  1.  S LN=LN+1
  1.  Q LN
  1.  ;
  1. SET1(STR,LN,COL,WD,RV) ; Sets up TMP array with screen data
  1.  ; Input:   STR             - Text to be set into the line of the body
  1.  ;          LN              - Line of the body to be set
  1.  ;          COL             - Column to begin displaying text in
  1.  ;          WD              - Width of the text to be displayed
  1.  ;          RV              - 1 - Set Video Control Characters. Null Otherwise
  1.  ;          ^TMP("IBJPC2")  - Current global array of body display lines
  1.  ; Output:  ^TMP("IBJPC2")  - Updated global array of body display lines
  1.  N IBX
  1.  S IBX=$G(^TMP("IBJPC2",$J,LN,0))
  1.  S IBX=$$SETSTR^VALM1(STR,IBX,COL,WD)
  1.  D SET^VALM10(LN,IBX)
  1.  I $G(RV)'="" D CNTRL^VALM10(LN,COL,WD,IORVON,IORVOFF)
  1.  Q
  1.  ;
  1. HELP ;EP
  1.  ; Help code
  1.  S X="?"
  1.  D DISP^XQORM1
  1.  W !!
  1.  Q
  1.  ;
  1. OP ;EP
  1.  ; Listman Protocol Action to Edit 'Other' HBCSR Site Parameters in node 62
  1.  N DA,DR,DIE,DTOUT
  1.  S DIE=350.9,DA=1
  1.  S DR="62.1Inquiry can be Triggered for Appointment"
  1.  S DR=DR_";62.11Inquiry can be Triggered for Admission"
  1.  S DR=DR_";62.12Days to wait to purge entry on HCSR Response"
  1.  S VALMBCK="R"                                  ; Refresh screen on return
  1.  Q:'$$LOCK^IBJPC1(62)                           ; Lock node 62 for editing
  1.  ;
  1.  D FULL^VALM1
  1.  D WARNMSG^IBJPC1                               ; Display warning message
  1.  ;
  1.  D ^DIE
  1.  D UNLOCK^IBJPC1(62)
  1.  Q
  1.  ;
  1. EXIT ;EP
  1.  ; Exit code
  1.  K ^TMP("IBJPC2",$J)
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. EXPND ;EP
  1.  ; Expand code
  1.  Q
  1.  ;