- 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 Feb 18, 2025@23:17:09 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