BPSCMT.m

BPSCMT ;BHAM ISC/SS - ECME SCREEN ADD/VIEW COMMENTS ;28-MAR-2005

 ;;1.0;E CLAIMS MGMT ENGINE;**1**;JUN 2004

 ;; Per VHA Directive 10-93-142, this routine should not be modified.

 ;USER SCREEN

 Q

 ;

CMT ;to invoke Add/View comments LM screen from main LM User Screen

 N BPRET,BPSEL

 I '$D(@(VALMAR)) Q

 D FULL^VALM1

 W !,"Enter the line number for which you wish to Add/View comments."

 S BPSEL=$$ASKLINE^BPSSCRU4("Select item","PC","Please select a SINGLE Patient Line item or a SINGLE Rx Line item when accessing Comments")

 I BPSEL<1 S VALMBCK="R" Q

 ;save some User Screen's configuration information VALVAR

 D SAVESEL(BPSEL,VALMAR)

 ;invoke Add/View comments LM screen

 D EN

 ;update the content of the main User Screen and redraw it

 I $G(^TMP("BPSSCR",$J,"VALM","UPDATE"))=1 D

 . D REDRAW^BPSSCRUD("Updating user screen for new comment(s)...")

 . K ^TMP("BPSSCR",$J,"VALM","UPDATE")

 ;return to main User Screen

 S VALMBCK="R"

 Q

 ;

EN ; -- main entry point for BPS LSTMN COMMENTS

 D EN^VALM("BPS LSTMN COMMENTS")

 Q

 ;

HDR ; -- header code

 N BPARR,BPX

 Q:'$D(@VALMAR@("VIEWPARAMS"))

 D RESTVIEW^BPSSCR01(.BPARR) ;Note: restore settings from current 

 ;("BPSCMT") TMP (because we have already put main screen setting in this TMP, see SAVESEL)

 S VALMHDR(1)="PHARMACY ECME"

 S VALMHDR(2)="SELECTED DIVISION(S): "_$$GETVDIVS^BPSSCR01(.BPARR,58)

 S VALMHDR(3)=$$GETVDETS^BPSSCR01(.BPARR)

 Q

 ;

INIT ; -- init variables and list array

 ;

 N BP59,BP59ARR,BPJSTPAT,BPINSDAT

 N BPX,BPPATIND,BPCLMIND,BPDFN,BPSSTR,BPPRNTGL,BPSINSUR,BP1LN

 I '$D(@VALMAR@("SELLN")) D SET^VALM10(1,"Needs to be called from BPS LSTMN ECME USRSCR template") Q

 S BPX=@VALMAR@("SELLN")

 S BPDFN=+$P(BPX,U,2)

 S BPSINSUR=+$P(BPX,U,3)

 S BP1LN=+$P(BPX,U,5)

 S BPPRNTGL=@VALMAR@("PARENT")

 S BPPATIND=+$P(BPX,U,6)

 S BPCLMIND=+$P(BPX,U,7)

 S BPJSTPAT=0

 I BPCLMIND=0 S BPJSTPAT=1

 I BPJSTPAT D

 . D MKPATARR(BPPRNTGL,BPPATIND,.BP59ARR)

 . S BPCLMIND=0

 . S BPPATIND=$S(BPPATIND<1:0,1:BPPATIND-1) ;since the MKARRELM will increase it by 1

 E  D

 . S BP59ARR(+$P(BPX,U,4))="" ;

 . S BPCLMIND=$S(BPCLMIND<1:0,1:BPCLMIND-1) ;since the MKARRELM will increase it by 1

 ;make LM array element(s)

 S BPPREV=0 ;to store data from previous patient/insurance group

 S BPLINE=1

 S BPINSDAT=$$GETINSUR^BPSSCRU2(+$O(BP59ARR(0)))

 S BPSINSUR=+BPINSDAT ;patient's insurance IEN

 I BPJSTPAT D MKPATELM^BPSCMT01(.BPLINE,VALMAR,BPDFN,BPINSDAT,.BPPATIND,.BPCLMIND,.BPPREV)

 S BP59=0

 F  S BP59=$O(BP59ARR(BP59)) Q:+BP59=0  D

 . D MKCLMELM^BPSCMT01(.BPLINE,VALMAR,BP59,BPDFN,BPSINSUR,.BPPATIND,.BPCLMIND,.BPPREV)

 . ;S BPLINE=BPLINE+1

 I BPJSTPAT D UPDPREV^BPSCMT01(VALMAR,.BPPATIND,.BPPREV)

 S VALMCNT=$S(BPLINE>1:BPLINE-1,1:BPLINE)

 Q

 ;/**

 ;make array of all claims (ptrs to #9002313.59)

 ;for the patient/insurance pair

 ;input

 ;BPPRNTGL - tmp global in parent LM

 ;BPPATIND - patient summary index

 ;BP59ARR - array to return results

MKPATARR(BPPRNTGL,BPPATIND,BP59ARR) ;

 N BPCLM,BPDFN,BPINS,BP59

 S BPCLM=0 F  S BPCLM=$O(@BPPRNTGL@("LMIND",BPPATIND,BPCLM)) Q:+BPCLM=0  D

 . S BPDFN=0 F  S BPDFN=$O(@BPPRNTGL@("LMIND",BPPATIND,BPCLM,BPDFN)) Q:+BPDFN=0  D

 . . S BPINS="" F  S BPINS=$O(@BPPRNTGL@("LMIND",BPPATIND,BPCLM,BPDFN,BPINS)) Q:BPINS=""  D

 . . . S BP59=0 F  S BP59=$O(@BPPRNTGL@("LMIND",BPPATIND,BPCLM,BPDFN,BPINS,BP59)) Q:+BP59=0  D

 . . . . S BP59ARR(BP59)=""

 Q

 ;

 ;/**

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; -- exit code

 K @VALMAR

 Q

 ;

EXPND ; -- expand code

 Q

 ;

 ;/**

 ;save selection in order to use inside enclosed ListManager copy

 ;input:

 ;BPSEL - selected line

 ;BPVALMR - parent VALMAR 

SAVESEL(BPSEL,BPVALMR) ;

 D CLEANIT

 S ^TMP("BPSCMT",$J,"VALM","SELLN")=BPSEL

 S ^TMP("BPSCMT",$J,"VALM","PARENT")=BPVALMR

 M ^TMP("BPSCMT",$J,"VALM","VIEWPARAMS")=@BPVALMR@("VIEWPARAMS")

 Q

 ;

CLEANIT ;

 K ^TMP("BPSCMT",$J,"VALM")

 Q

 ;

 ;redraw the screen for Add/View comments option

REDRWCMT ;

 N BPARR,BPVALMR,BPSEL

 S BPSEL=$G(@VALMAR@("SELLN"))

 S BPVALMR=$G(@VALMAR@("PARENT"))

 D CLEAN^VALM10

 K @VALMAR

 S @VALMAR@("SELLN")=BPSEL

 S @VALMAR@("PARENT")=BPVALMR

 M @VALMAR@("VIEWPARAMS")=@BPVALMR@("VIEWPARAMS")

 D INIT^BPSCMT

 D HDR^BPSCMT

 S VALMBCK="R"

 Q

 ;

 ;

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---BPSCMT   4305     printed  Mar 13, 2025@20:55:24                                                                                                                                                                                                      Page 2

BPSCMT    ;BHAM ISC/SS - ECME SCREEN ADD/VIEW COMMENTS ;28-MAR-2005

 +1       ;;1.0;E CLAIMS MGMT ENGINE;**1**;JUN 2004

 +2       ;; Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;USER SCREEN

 +4        QUIT 

 +5       ;

CMT       ;to invoke Add/View comments LM screen from main LM User Screen

 +1        NEW BPRET,BPSEL

 +2        IF '$DATA(@(VALMAR))

               QUIT 

 +3        DO FULL^VALM1

 +4        WRITE !,"Enter the line number for which you wish to Add/View comments."

 +5        SET BPSEL=$$ASKLINE^BPSSCRU4("Select item","PC","Please select a SINGLE Patient Line item or a SINGLE Rx Line item when accessing Comments")

 +6        IF BPSEL<1

               SET VALMBCK="R"

               QUIT 

 +7       ;save some User Screen's configuration information VALVAR

 +8        DO SAVESEL(BPSEL,VALMAR)

 +9       ;invoke Add/View comments LM screen

 +10       DO EN

 +11      ;update the content of the main User Screen and redraw it

 +12       IF $GET(^TMP("BPSSCR",$JOB,"VALM","UPDATE"))=1

               Begin DoDot:1

 +13               DO REDRAW^BPSSCRUD("Updating user screen for new comment(s)...")

 +14               KILL ^TMP("BPSSCR",$JOB,"VALM","UPDATE")

               End DoDot:1

 +15      ;return to main User Screen

 +16       SET VALMBCK="R"

 +17       QUIT 

 +18      ;

EN        ; -- main entry point for BPS LSTMN COMMENTS

 +1        DO EN^VALM("BPS LSTMN COMMENTS")

 +2        QUIT 

 +3       ;

HDR       ; -- header code

 +1        NEW BPARR,BPX

 +2        if '$DATA(@VALMAR@("VIEWPARAMS"))

               QUIT 

 +3       ;Note: restore settings from current 

           DO RESTVIEW^BPSSCR01(.BPARR)

 +4       ;("BPSCMT") TMP (because we have already put main screen setting in this TMP, see SAVESEL)

 +5        SET VALMHDR(1)="PHARMACY ECME"

 +6        SET VALMHDR(2)="SELECTED DIVISION(S): "_$$GETVDIVS^BPSSCR01(.BPARR,58)

 +7        SET VALMHDR(3)=$$GETVDETS^BPSSCR01(.BPARR)

 +8        QUIT 

 +9       ;

INIT      ; -- init variables and list array

 +1       ;

 +2        NEW BP59,BP59ARR,BPJSTPAT,BPINSDAT

 +3        NEW BPX,BPPATIND,BPCLMIND,BPDFN,BPSSTR,BPPRNTGL,BPSINSUR,BP1LN

 +4        IF '$DATA(@VALMAR@("SELLN"))

               DO SET^VALM10(1,"Needs to be called from BPS LSTMN ECME USRSCR template")

               QUIT 

 +5        SET BPX=@VALMAR@("SELLN")

 +6        SET BPDFN=+$PIECE(BPX,U,2)

 +7        SET BPSINSUR=+$PIECE(BPX,U,3)

 +8        SET BP1LN=+$PIECE(BPX,U,5)

 +9        SET BPPRNTGL=@VALMAR@("PARENT")

 +10       SET BPPATIND=+$PIECE(BPX,U,6)

 +11       SET BPCLMIND=+$PIECE(BPX,U,7)

 +12       SET BPJSTPAT=0

 +13       IF BPCLMIND=0

               SET BPJSTPAT=1

 +14       IF BPJSTPAT

               Begin DoDot:1

 +15               DO MKPATARR(BPPRNTGL,BPPATIND,.BP59ARR)

 +16               SET BPCLMIND=0

 +17      ;since the MKARRELM will increase it by 1

                   SET BPPATIND=$SELECT(BPPATIND<1:0,1:BPPATIND-1)

               End DoDot:1

 +18      IF '$TEST

               Begin DoDot:1

 +19      ;

                   SET BP59ARR(+$PIECE(BPX,U,4))=""

 +20      ;since the MKARRELM will increase it by 1

                   SET BPCLMIND=$SELECT(BPCLMIND<1:0,1:BPCLMIND-1)

               End DoDot:1

 +21      ;make LM array element(s)

 +22      ;to store data from previous patient/insurance group

           SET BPPREV=0

 +23       SET BPLINE=1

 +24       SET BPINSDAT=$$GETINSUR^BPSSCRU2(+$ORDER(BP59ARR(0)))

 +25      ;patient's insurance IEN

           SET BPSINSUR=+BPINSDAT

 +26       IF BPJSTPAT

               DO MKPATELM^BPSCMT01(.BPLINE,VALMAR,BPDFN,BPINSDAT,.BPPATIND,.BPCLMIND,.BPPREV)

 +27       SET BP59=0

 +28       FOR 

               SET BP59=$ORDER(BP59ARR(BP59))

               if +BP59=0

                   QUIT 

               Begin DoDot:1

 +29               DO MKCLMELM^BPSCMT01(.BPLINE,VALMAR,BP59,BPDFN,BPSINSUR,.BPPATIND,.BPCLMIND,.BPPREV)

 +30      ;S BPLINE=BPLINE+1

               End DoDot:1

 +31       IF BPJSTPAT

               DO UPDPREV^BPSCMT01(VALMAR,.BPPATIND,.BPPREV)

 +32       SET VALMCNT=$SELECT(BPLINE>1:BPLINE-1,1:BPLINE)

 +33       QUIT 

 +34      ;/**

 +35      ;make array of all claims (ptrs to #9002313.59)

 +36      ;for the patient/insurance pair

 +37      ;input

 +38      ;BPPRNTGL - tmp global in parent LM

 +39      ;BPPATIND - patient summary index

 +40      ;BP59ARR - array to return results

MKPATARR(BPPRNTGL,BPPATIND,BP59ARR) ;

 +1        NEW BPCLM,BPDFN,BPINS,BP59

 +2        SET BPCLM=0

           FOR 

               SET BPCLM=$ORDER(@BPPRNTGL@("LMIND",BPPATIND,BPCLM))

               if +BPCLM=0

                   QUIT 

               Begin DoDot:1

 +3                SET BPDFN=0

                   FOR 

                       SET BPDFN=$ORDER(@BPPRNTGL@("LMIND",BPPATIND,BPCLM,BPDFN))

                       if +BPDFN=0

                           QUIT 

                       Begin DoDot:2

 +4                        SET BPINS=""

                           FOR 

                               SET BPINS=$ORDER(@BPPRNTGL@("LMIND",BPPATIND,BPCLM,BPDFN,BPINS))

                               if BPINS=""

                                   QUIT 

                               Begin DoDot:3

 +5                                SET BP59=0

                                   FOR 

                                       SET BP59=$ORDER(@BPPRNTGL@("LMIND",BPPATIND,BPCLM,BPDFN,BPINS,BP59))

                                       if +BP59=0

                                           QUIT 

                                       Begin DoDot:4

 +6                                        SET BP59ARR(BP59)=""

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +7        QUIT 

 +8       ;

 +9       ;/**

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        KILL @VALMAR

 +2        QUIT 

 +3       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;

 +3       ;/**

 +4       ;save selection in order to use inside enclosed ListManager copy

 +5       ;input:

 +6       ;BPSEL - selected line

 +7       ;BPVALMR - parent VALMAR 

SAVESEL(BPSEL,BPVALMR) ;

 +1        DO CLEANIT

 +2        SET ^TMP("BPSCMT",$JOB,"VALM","SELLN")=BPSEL

 +3        SET ^TMP("BPSCMT",$JOB,"VALM","PARENT")=BPVALMR

 +4        MERGE ^TMP("BPSCMT",$JOB,"VALM","VIEWPARAMS")=@BPVALMR@("VIEWPARAMS")

 +5        QUIT 

 +6       ;

CLEANIT   ;

 +1        KILL ^TMP("BPSCMT",$JOB,"VALM")

 +2        QUIT 

 +3       ;

 +4       ;redraw the screen for Add/View comments option

REDRWCMT  ;

 +1        NEW BPARR,BPVALMR,BPSEL

 +2        SET BPSEL=$GET(@VALMAR@("SELLN"))

 +3        SET BPVALMR=$GET(@VALMAR@("PARENT"))

 +4        DO CLEAN^VALM10

 +5        KILL @VALMAR

 +6        SET @VALMAR@("SELLN")=BPSEL

 +7        SET @VALMAR@("PARENT")=BPVALMR

 +8        MERGE @VALMAR@("VIEWPARAMS")=@BPVALMR@("VIEWPARAMS")

 +9        DO INIT^BPSCMT

 +10       DO HDR^BPSCMT

 +11       SET VALMBCK="R"

 +12       QUIT 

 +13      ;

 +14      ;

 +15      ;