BPSSCR ;BHAM ISC/SS - ECME USER SCREEN MAIN ;10-MAR-2005
;;1.0;E CLAIMS MGMT ENGINE;**1,22**;JUN 2004;Build 28
;;Per VA Directive 6402, this routine should not be modified.
;USER SCREEN
Q
EN ; -- main entry point for BPS ECME USER SCREEN
D EN^VALM("BPS LSTMN ECME USRSCR")
Q
;
HDR ; -- header code
S VALMHDR(1)=$$HDR^BPSSCR01(1)
S VALMHDR(2)=$$HDR^BPSSCR01(2)
S VALMHDR(3)=$$HDR^BPSSCR01(3)
Q
;
INIT ; -- init variables and list array
D KILINSGL ;clean up insurance list
W !,"Please wait..."
S VALMCNT=$$INIT^BPSSCR01()
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
D CLEANUP
Q
;
EXPND ; -- expand code
Q
;
CLEANUP ;
K @VALMAR
D KILINSGL ;clean up insurance list
S BPARR("TEMPCV")="" ; ensure Temp CV flag is cleared
Q
; BPINSNAM - insurance name; BPPHONE - insurance phone number
CHKINSUR(BPINSNAM,BPPHONE) ; returns a unique number for insurance (among those found in claims)
N BPINSID,BPMAXN
I $L(BPINSNAM)=0 S BPINSNAM="UNKNOWN"
I $L(BPPHONE)=0 S BPPHONE="N/A"
S BPINSID=+$G(^TMP($J,"BPSSCRINS","VAL",BPINSNAM,BPPHONE))
I BPINSID=0 D
. S BPMAXN=$G(^TMP($J,"BPSSCRINS","MAXN"))+1
. S ^TMP($J,"BPSSCRINS","VAL",BPINSNAM,BPPHONE)=BPMAXN
. S ^TMP($J,"BPSSCRINS","MAXN")=BPMAXN
Q +$G(^TMP($J,"BPSSCRINS","VAL",BPINSNAM,BPPHONE))
;
KILINSGL ;
K ^TMP($J,"BPSSCRINS")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSSCR 1395 printed Dec 13, 2024@01:53:01 Page 2
BPSSCR ;BHAM ISC/SS - ECME USER SCREEN MAIN ;10-MAR-2005
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,22**;JUN 2004;Build 28
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;USER SCREEN
+4 QUIT
EN ; -- main entry point for BPS ECME USER SCREEN
+1 DO EN^VALM("BPS LSTMN ECME USRSCR")
+2 QUIT
+3 ;
HDR ; -- header code
+1 SET VALMHDR(1)=$$HDR^BPSSCR01(1)
+2 SET VALMHDR(2)=$$HDR^BPSSCR01(2)
+3 SET VALMHDR(3)=$$HDR^BPSSCR01(3)
+4 QUIT
+5 ;
INIT ; -- init variables and list array
+1 ;clean up insurance list
DO KILINSGL
+2 WRITE !,"Please wait..."
+3 SET VALMCNT=$$INIT^BPSSCR01()
+4 QUIT
+5 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 DO CLEANUP
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
CLEANUP ;
+1 KILL @VALMAR
+2 ;clean up insurance list
DO KILINSGL
+3 ; ensure Temp CV flag is cleared
SET BPARR("TEMPCV")=""
+4 QUIT
+5 ; BPINSNAM - insurance name; BPPHONE - insurance phone number
CHKINSUR(BPINSNAM,BPPHONE) ; returns a unique number for insurance (among those found in claims)
+1 NEW BPINSID,BPMAXN
+2 IF $LENGTH(BPINSNAM)=0
SET BPINSNAM="UNKNOWN"
+3 IF $LENGTH(BPPHONE)=0
SET BPPHONE="N/A"
+4 SET BPINSID=+$GET(^TMP($JOB,"BPSSCRINS","VAL",BPINSNAM,BPPHONE))
+5 IF BPINSID=0
Begin DoDot:1
+6 SET BPMAXN=$GET(^TMP($JOB,"BPSSCRINS","MAXN"))+1
+7 SET ^TMP($JOB,"BPSSCRINS","VAL",BPINSNAM,BPPHONE)=BPMAXN
+8 SET ^TMP($JOB,"BPSSCRINS","MAXN")=BPMAXN
End DoDot:1
+9 QUIT +$GET(^TMP($JOB,"BPSSCRINS","VAL",BPINSNAM,BPPHONE))
+10 ;
KILINSGL ;
+1 KILL ^TMP($JOB,"BPSSCRINS")
+2 QUIT
+3 ;
