BPSCMT01 ;BHAM ISC/SS - ECME ADD/VIEW COMMENTS ;05-APR-05
;;1.0;E CLAIMS MGMT ENGINE;**1,5,20**;JUN 2004;Build 27
;;Per VA Directive 6402, this routine should not be modified.
;USER SCREEN
Q
;
ADDP ;entry point for Add Pharmacy option in Add/View screen
N BPSCMTRX
S BPSCMTRX=1
;
ADD ;entry point for Add option in Add/View screen
;full screen mode
D FULL^VALM1
D ADDCMT
S VALMBCK="R"
Q
;make element for the patient
;BPLINE - line number in LM ARRAY (by ref)
;BPTMP - VALMAR (TMP global for LM)
;BPDFN - patient's DFN
;BPSINSUR - ;patient's insurance ien^name^phone
;BPLMIND - passed by ref - current patient(/insurance) index ( to make 1, 2,etc)
;BPDRIND - passed by ref - current claim level index ( to make .1, .2, .10,... .20,... )
;BPPREV - to store previous data to update patient summary line
MKPATELM(BPLINE,BPTMP,BPDFN,BPSINSUR,BPLMIND,BPDRIND,BPPREV) ;*/
N BPSSTR,BPLNS,BPSTAT
;PATIENT SUMMARY level
;-------- first process previous patient & insurance group
;determine patient summary statuses for the previous "patient" group
;update the record for previous patient summary after we went thru all his claims
I BPLMIND>0,+BPPREV=BPLMIND D UPDPREV(BPTMP,BPLMIND,BPPREV)
;process new "patient & insurance" group ------------------
S BPDRIND=0
S BPLMIND=(BPLMIND\1)+1
;save the all necessary data for the patient & insurance to use as previous for STAT4PAT later on
S BPPREV=BPLMIND_U_BPLINE_U_BPDFN_U_$$PATINF^BPSSCR02(BPDFN,BPSINSUR)_U_(+BPSINSUR)
S BPSSTR=$$LJ^BPSSCR02(BPLMIND,4)_$P(BPPREV,U,4)
D SAVEARR^BPSSCR02(BPTMP,BPLMIND,BPDRIND,BPDFN,0,BPLINE,BPSSTR,+BPSINSUR)
S BPLINE=BPLINE+1
Q
;
;/**
;update patient summary info in LM array
UPDPREV(BPTMP,BPLMIND,BPPREV) ;
N BPSSTR
;update the record for previous patient summary after we went thru all his claims
S BPSSTR=$$LJ^BPSSCR02(BPLMIND,4)_$P(BPPREV,U,4)_" "_$$STAT4PAT^BPSSCR02(BPLMIND)
D SAVEARR^BPSSCR02(BPTMP,BPLMIND,0,+$P(BPPREV,U,3),0,+$P(BPPREV,U,2),BPSSTR,+$P(BPPREV,U,5))
Q
;/**
;make array element for a claim
;BPLINE - line number in LM ARRAY (by ref)
;BPTMP - VALMAR (TMP global for LM)
;BP59 - ptr to 9002313.59
;BPDFN - patient's DFN
;BPSINSUR - ;patient's insurance ien
;BPLMIND - passed by ref - current patient(/insurance) index ( to make 1, 2,etc)
;BPDRIND - passed by ref - current claim level index ( to make .1, .2, .10,... .20,... )
;BPPREV - to store previous data to update patient summary line
MKCLMELM(BPLINE,BPTMP,BP59,BPDFN,BPSINSUR,BPLMIND,BPDRIND,BPPREV) ;*/
N BPSSTR,BPLNS,BPSTAT
;CLAIMS level
I +$O(@BPTMP@("LMIND",BPLMIND,BPDRIND,BPDFN,0))'=BP59 D
. S BPDRIND=BPDRIND+1
. S BPSSTR=" "_$$LJ^BPSSCR02(+$P(BPLMIND,".")_"."_BPDRIND,5)_" "_$$CLAIMINF^BPSSCR02(BP59)
. D SAVEARR^BPSSCR02(BPTMP,BPLMIND,BPDRIND,BPDFN,BP59,BPLINE,BPSSTR,BPSINSUR)
. S BPLINE=BPLINE+1
. N BPARR,X
. ;use ADDINF^BPSSCR03 to get comments
. S BPLNS=$$ADDINF^BPSSCR03(BP59,.BPARR,74,"C")
. F X=1:1:BPLNS D
. . I $G(BPARR(X))="" Q
. . D SAVEARR^BPSSCR02(BPTMP,BPLMIND,BPDRIND,BPDFN,BP59,BPLINE," "_BPARR(X),BPSINSUR)
. . S BPLINE=BPLINE+1
Q
;/**
;input:
; BPDFLT1 - default selection (optional)
;add comment
;the user can select
; a patient - comment will be added to all claims
; a claim - comment will be added only to this claim
ADDCMT ;*/
N BPRET,BPSEL,BP59ARR,BPRCMNT,BP59,BPNOW,BPLCK,BPREC,BPDFLT1
I '$D(@(VALMAR)) Q
D FULL^VALM1
;select an item
W !,"Enter the line number for which you wish to Add comments."
S BPDFLT1=$G(^TMP("BPSCMT",$J,"VALM","SELLN"))
S BPDFLT1=$P(BPDFLT1,U,6)_"."_$P(BPDFLT1,U,7)
S BPSEL=$$ASKLINE^BPSSCRU4("Select item","PC","Please select Patient Line to add a comment to all RXs or a SINGLE RXs",$G(BPDFLT1))
I BPSEL<1 S VALMBCK="R" Q
;if single claim
I $P(BPSEL,U,7)>0 S BP59ARR(+$P(BPSEL,U,4))=""
E D MKPATARR^BPSCMT(VALMAR,+$P(BPSEL,U,6),.BP59ARR)
S BPRCMNT=$$COMMENT^BPSSCRCL("Enter Comment",60)
I (BPRCMNT="^")!($L(BPRCMNT)=0)!(BPRCMNT?1" "." ") Q
S BP59=0
F S BP59=$O(BP59ARR(BP59)) Q:+BP59=0 D
. N BPDA,BPERR,%
. D NOW^%DTC
. S BPNOW=%
. L +^BPST(9002313.59111,+BP59):10
. S BPLCK=$T
. I 'BPLCK Q ;quit
. D INSITEM(9002313.59111,+BP59,BPNOW)
. S BPREC=$O(^BPST(BP59,11,"B",BPNOW,0))
. I BPREC>0 D
. . S BPDA(9002313.59111,BPREC_","_BP59_",",.02)=+$G(DUZ)
. . S BPDA(9002313.59111,BPREC_","_BP59_",",.03)=$G(BPRCMNT)
. . I +$G(BPSCMTRX)=1 S BPDA(9002313.59111,BPREC_","_BP59_",",.04)=1
. . D FILE^DIE("","BPDA","BPERR")
. I BPLCK L -^BPST(9002313.59111,+BP59)
D REDRWCMT^BPSCMT ;update the content of the screen and display it
S ^TMP("BPSSCR",$J,"VALM","UPDATE")=1
Q
;
;/**
;BPSFILE - subfile# (9002313.59111) for comment
;BPIEN - ien for file in which the new subfile entry will be inserted
;BPVAL01 - .01 value for the new entry
INSITEM(BPSFILE,BPIEN,BPVAL01) ;*/
N BPSSI,BPIENS,BPFDA,BPER
S BPIENS="+1,"_BPIEN_","
S BPFDA(BPSFILE,BPIENS,.01)=BPVAL01
D UPDATE^DIE("","BPFDA","BPSSI","BPER")
I $D(BPER) D BMES^XPDUTL(BPER("DIERR",1,"TEXT",1))
Q
;
;Function to return username data from NEW PERSON file VA(200)
; Parameter
; BPSDUZ - IEN of NEW PERSON file
;
; Returns
; Username in format of Lastname, Firstname MI
USERNAM(BPSDUZ) ; Return username from NEW PERSON file
N BPSNMI,BPSNMO
I '$G(BPSDUZ) Q ""
S BPSNMI=$$VA200NM^BPSJUTL(+BPSDUZ,"")
I $G(BPSNMI)="" Q ""
Q:$P(BPSNMI,U)="" ""
S BPSNMO=$P(BPSNMI,U)
Q:$P(BPSNMI,U,2)="" BPSNMO
S BPSNMO=BPSNMO_", "_$P(BPSNMI,U,2)
Q:$P(BPSNMI,U,3)="" BPSNMO
S BPSNMO=BPSNMO_" "_$E($P(BPSNMI,U,3),1)
Q BPSNMO
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSCMT01 5655 printed Oct 16, 2024@17:51:34 Page 2
BPSCMT01 ;BHAM ISC/SS - ECME ADD/VIEW COMMENTS ;05-APR-05
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5,20**;JUN 2004;Build 27
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;USER SCREEN
+4 QUIT
+5 ;
ADDP ;entry point for Add Pharmacy option in Add/View screen
+1 NEW BPSCMTRX
+2 SET BPSCMTRX=1
+3 ;
ADD ;entry point for Add option in Add/View screen
+1 ;full screen mode
+2 DO FULL^VALM1
+3 DO ADDCMT
+4 SET VALMBCK="R"
+5 QUIT
+6 ;make element for the patient
+7 ;BPLINE - line number in LM ARRAY (by ref)
+8 ;BPTMP - VALMAR (TMP global for LM)
+9 ;BPDFN - patient's DFN
+10 ;BPSINSUR - ;patient's insurance ien^name^phone
+11 ;BPLMIND - passed by ref - current patient(/insurance) index ( to make 1, 2,etc)
+12 ;BPDRIND - passed by ref - current claim level index ( to make .1, .2, .10,... .20,... )
+13 ;BPPREV - to store previous data to update patient summary line
MKPATELM(BPLINE,BPTMP,BPDFN,BPSINSUR,BPLMIND,BPDRIND,BPPREV) ;*/
+1 NEW BPSSTR,BPLNS,BPSTAT
+2 ;PATIENT SUMMARY level
+3 ;-------- first process previous patient & insurance group
+4 ;determine patient summary statuses for the previous "patient" group
+5 ;update the record for previous patient summary after we went thru all his claims
+6 IF BPLMIND>0
IF +BPPREV=BPLMIND
DO UPDPREV(BPTMP,BPLMIND,BPPREV)
+7 ;process new "patient & insurance" group ------------------
+8 SET BPDRIND=0
+9 SET BPLMIND=(BPLMIND\1)+1
+10 ;save the all necessary data for the patient & insurance to use as previous for STAT4PAT later on
+11 SET BPPREV=BPLMIND_U_BPLINE_U_BPDFN_U_$$PATINF^BPSSCR02(BPDFN,BPSINSUR)_U_(+BPSINSUR)
+12 SET BPSSTR=$$LJ^BPSSCR02(BPLMIND,4)_$PIECE(BPPREV,U,4)
+13 DO SAVEARR^BPSSCR02(BPTMP,BPLMIND,BPDRIND,BPDFN,0,BPLINE,BPSSTR,+BPSINSUR)
+14 SET BPLINE=BPLINE+1
+15 QUIT
+16 ;
+17 ;/**
+18 ;update patient summary info in LM array
UPDPREV(BPTMP,BPLMIND,BPPREV) ;
+1 NEW BPSSTR
+2 ;update the record for previous patient summary after we went thru all his claims
+3 SET BPSSTR=$$LJ^BPSSCR02(BPLMIND,4)_$PIECE(BPPREV,U,4)_" "_$$STAT4PAT^BPSSCR02(BPLMIND)
+4 DO SAVEARR^BPSSCR02(BPTMP,BPLMIND,0,+$PIECE(BPPREV,U,3),0,+$PIECE(BPPREV,U,2),BPSSTR,+$PIECE(BPPREV,U,5))
+5 QUIT
+6 ;/**
+7 ;make array element for a claim
+8 ;BPLINE - line number in LM ARRAY (by ref)
+9 ;BPTMP - VALMAR (TMP global for LM)
+10 ;BP59 - ptr to 9002313.59
+11 ;BPDFN - patient's DFN
+12 ;BPSINSUR - ;patient's insurance ien
+13 ;BPLMIND - passed by ref - current patient(/insurance) index ( to make 1, 2,etc)
+14 ;BPDRIND - passed by ref - current claim level index ( to make .1, .2, .10,... .20,... )
+15 ;BPPREV - to store previous data to update patient summary line
MKCLMELM(BPLINE,BPTMP,BP59,BPDFN,BPSINSUR,BPLMIND,BPDRIND,BPPREV) ;*/
+1 NEW BPSSTR,BPLNS,BPSTAT
+2 ;CLAIMS level
+3 IF +$ORDER(@BPTMP@("LMIND",BPLMIND,BPDRIND,BPDFN,0))'=BP59
Begin DoDot:1
+4 SET BPDRIND=BPDRIND+1
+5 SET BPSSTR=" "_$$LJ^BPSSCR02(+$PIECE(BPLMIND,".")_"."_BPDRIND,5)_" "_$$CLAIMINF^BPSSCR02(BP59)
+6 DO SAVEARR^BPSSCR02(BPTMP,BPLMIND,BPDRIND,BPDFN,BP59,BPLINE,BPSSTR,BPSINSUR)
+7 SET BPLINE=BPLINE+1
+8 NEW BPARR,X
+9 ;use ADDINF^BPSSCR03 to get comments
+10 SET BPLNS=$$ADDINF^BPSSCR03(BP59,.BPARR,74,"C")
+11 FOR X=1:1:BPLNS
Begin DoDot:2
+12 IF $GET(BPARR(X))=""
QUIT
+13 DO SAVEARR^BPSSCR02(BPTMP,BPLMIND,BPDRIND,BPDFN,BP59,BPLINE," "_BPARR(X),BPSINSUR)
+14 SET BPLINE=BPLINE+1
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;/**
+17 ;input:
+18 ; BPDFLT1 - default selection (optional)
+19 ;add comment
+20 ;the user can select
+21 ; a patient - comment will be added to all claims
+22 ; a claim - comment will be added only to this claim
ADDCMT ;*/
+1 NEW BPRET,BPSEL,BP59ARR,BPRCMNT,BP59,BPNOW,BPLCK,BPREC,BPDFLT1
+2 IF '$DATA(@(VALMAR))
QUIT
+3 DO FULL^VALM1
+4 ;select an item
+5 WRITE !,"Enter the line number for which you wish to Add comments."
+6 SET BPDFLT1=$GET(^TMP("BPSCMT",$JOB,"VALM","SELLN"))
+7 SET BPDFLT1=$PIECE(BPDFLT1,U,6)_"."_$PIECE(BPDFLT1,U,7)
+8 SET BPSEL=$$ASKLINE^BPSSCRU4("Select item","PC","Please select Patient Line to add a comment to all RXs or a SINGLE RXs",$GET(BPDFLT1))
+9 IF BPSEL<1
SET VALMBCK="R"
QUIT
+10 ;if single claim
+11 IF $PIECE(BPSEL,U,7)>0
SET BP59ARR(+$PIECE(BPSEL,U,4))=""
+12 IF '$TEST
DO MKPATARR^BPSCMT(VALMAR,+$PIECE(BPSEL,U,6),.BP59ARR)
+13 SET BPRCMNT=$$COMMENT^BPSSCRCL("Enter Comment",60)
+14 IF (BPRCMNT="^")!($LENGTH(BPRCMNT)=0)!(BPRCMNT?1" "." ")
QUIT
+15 SET BP59=0
+16 FOR
SET BP59=$ORDER(BP59ARR(BP59))
if +BP59=0
QUIT
Begin DoDot:1
+17 NEW BPDA,BPERR,%
+18 DO NOW^%DTC
+19 SET BPNOW=%
+20 LOCK +^BPST(9002313.59111,+BP59):10
+21 SET BPLCK=$TEST
+22 ;quit
IF 'BPLCK
QUIT
+23 DO INSITEM(9002313.59111,+BP59,BPNOW)
+24 SET BPREC=$ORDER(^BPST(BP59,11,"B",BPNOW,0))
+25 IF BPREC>0
Begin DoDot:2
+26 SET BPDA(9002313.59111,BPREC_","_BP59_",",.02)=+$GET(DUZ)
+27 SET BPDA(9002313.59111,BPREC_","_BP59_",",.03)=$GET(BPRCMNT)
+28 IF +$GET(BPSCMTRX)=1
SET BPDA(9002313.59111,BPREC_","_BP59_",",.04)=1
+29 DO FILE^DIE("","BPDA","BPERR")
End DoDot:2
+30 IF BPLCK
LOCK -^BPST(9002313.59111,+BP59)
End DoDot:1
+31 ;update the content of the screen and display it
DO REDRWCMT^BPSCMT
+32 SET ^TMP("BPSSCR",$JOB,"VALM","UPDATE")=1
+33 QUIT
+34 ;
+35 ;/**
+36 ;BPSFILE - subfile# (9002313.59111) for comment
+37 ;BPIEN - ien for file in which the new subfile entry will be inserted
+38 ;BPVAL01 - .01 value for the new entry
INSITEM(BPSFILE,BPIEN,BPVAL01) ;*/
+1 NEW BPSSI,BPIENS,BPFDA,BPER
+2 SET BPIENS="+1,"_BPIEN_","
+3 SET BPFDA(BPSFILE,BPIENS,.01)=BPVAL01
+4 DO UPDATE^DIE("","BPFDA","BPSSI","BPER")
+5 IF $DATA(BPER)
DO BMES^XPDUTL(BPER("DIERR",1,"TEXT",1))
+6 QUIT
+7 ;
+8 ;Function to return username data from NEW PERSON file VA(200)
+9 ; Parameter
+10 ; BPSDUZ - IEN of NEW PERSON file
+11 ;
+12 ; Returns
+13 ; Username in format of Lastname, Firstname MI
USERNAM(BPSDUZ) ; Return username from NEW PERSON file
+1 NEW BPSNMI,BPSNMO
+2 IF '$GET(BPSDUZ)
QUIT ""
+3 SET BPSNMI=$$VA200NM^BPSJUTL(+BPSDUZ,"")
+4 IF $GET(BPSNMI)=""
QUIT ""
+5 if $PIECE(BPSNMI,U)=""
QUIT ""
+6 SET BPSNMO=$PIECE(BPSNMI,U)
+7 if $PIECE(BPSNMI,U,2)=""
QUIT BPSNMO
+8 SET BPSNMO=BPSNMO_", "_$PIECE(BPSNMI,U,2)
+9 if $PIECE(BPSNMI,U,3)=""
QUIT BPSNMO
+10 SET BPSNMO=BPSNMO_" "_$EXTRACT($PIECE(BPSNMI,U,3),1)
+11 QUIT BPSNMO
