BPSSCR.m

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 ---BPSSCR   1395     printed  Apr 09, 2024@20:56:55                                                                                                                                                                                                      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       ;