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