Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BPSCMT01

BPSCMT01.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;USER SCREEN
  1. Q
  1. ;
  1. ADDP ;entry point for Add Pharmacy option in Add/View screen
  1. N BPSCMTRX
  1. S BPSCMTRX=1
  1. ;
  1. ADD ;entry point for Add option in Add/View screen
  1. ;full screen mode
  1. D FULL^VALM1
  1. D ADDCMT
  1. S VALMBCK="R"
  1. Q
  1. ;make element for the patient
  1. ;BPLINE - line number in LM ARRAY (by ref)
  1. ;BPTMP - VALMAR (TMP global for LM)
  1. ;BPDFN - patient's DFN
  1. ;BPSINSUR - ;patient's insurance ien^name^phone
  1. ;BPLMIND - passed by ref - current patient(/insurance) index ( to make 1, 2,etc)
  1. ;BPDRIND - passed by ref - current claim level index ( to make .1, .2, .10,... .20,... )
  1. ;BPPREV - to store previous data to update patient summary line
  1. MKPATELM(BPLINE,BPTMP,BPDFN,BPSINSUR,BPLMIND,BPDRIND,BPPREV) ;*/
  1. N BPSSTR,BPLNS,BPSTAT
  1. ;PATIENT SUMMARY level
  1. ;-------- first process previous patient & insurance group
  1. ;determine patient summary statuses for the previous "patient" group
  1. ;update the record for previous patient summary after we went thru all his claims
  1. I BPLMIND>0,+BPPREV=BPLMIND D UPDPREV(BPTMP,BPLMIND,BPPREV)
  1. ;process new "patient & insurance" group ------------------
  1. S BPDRIND=0
  1. S BPLMIND=(BPLMIND\1)+1
  1. ;save the all necessary data for the patient & insurance to use as previous for STAT4PAT later on
  1. S BPPREV=BPLMIND_U_BPLINE_U_BPDFN_U_$$PATINF^BPSSCR02(BPDFN,BPSINSUR)_U_(+BPSINSUR)
  1. S BPSSTR=$$LJ^BPSSCR02(BPLMIND,4)_$P(BPPREV,U,4)
  1. D SAVEARR^BPSSCR02(BPTMP,BPLMIND,BPDRIND,BPDFN,0,BPLINE,BPSSTR,+BPSINSUR)
  1. S BPLINE=BPLINE+1
  1. Q
  1. ;
  1. ;/**
  1. ;update patient summary info in LM array
  1. UPDPREV(BPTMP,BPLMIND,BPPREV) ;
  1. N BPSSTR
  1. ;update the record for previous patient summary after we went thru all his claims
  1. S BPSSTR=$$LJ^BPSSCR02(BPLMIND,4)_$P(BPPREV,U,4)_" "_$$STAT4PAT^BPSSCR02(BPLMIND)
  1. D SAVEARR^BPSSCR02(BPTMP,BPLMIND,0,+$P(BPPREV,U,3),0,+$P(BPPREV,U,2),BPSSTR,+$P(BPPREV,U,5))
  1. Q
  1. ;/**
  1. ;make array element for a claim
  1. ;BPLINE - line number in LM ARRAY (by ref)
  1. ;BPTMP - VALMAR (TMP global for LM)
  1. ;BP59 - ptr to 9002313.59
  1. ;BPDFN - patient's DFN
  1. ;BPSINSUR - ;patient's insurance ien
  1. ;BPLMIND - passed by ref - current patient(/insurance) index ( to make 1, 2,etc)
  1. ;BPDRIND - passed by ref - current claim level index ( to make .1, .2, .10,... .20,... )
  1. ;BPPREV - to store previous data to update patient summary line
  1. MKCLMELM(BPLINE,BPTMP,BP59,BPDFN,BPSINSUR,BPLMIND,BPDRIND,BPPREV) ;*/
  1. N BPSSTR,BPLNS,BPSTAT
  1. ;CLAIMS level
  1. I +$O(@BPTMP@("LMIND",BPLMIND,BPDRIND,BPDFN,0))'=BP59 D
  1. . S BPDRIND=BPDRIND+1
  1. . S BPSSTR=" "_$$LJ^BPSSCR02(+$P(BPLMIND,".")_"."_BPDRIND,5)_" "_$$CLAIMINF^BPSSCR02(BP59)
  1. . D SAVEARR^BPSSCR02(BPTMP,BPLMIND,BPDRIND,BPDFN,BP59,BPLINE,BPSSTR,BPSINSUR)
  1. . S BPLINE=BPLINE+1
  1. . N BPARR,X
  1. . ;use ADDINF^BPSSCR03 to get comments
  1. . S BPLNS=$$ADDINF^BPSSCR03(BP59,.BPARR,74,"C")
  1. . F X=1:1:BPLNS D
  1. . . I $G(BPARR(X))="" Q
  1. . . D SAVEARR^BPSSCR02(BPTMP,BPLMIND,BPDRIND,BPDFN,BP59,BPLINE," "_BPARR(X),BPSINSUR)
  1. . . S BPLINE=BPLINE+1
  1. Q
  1. ;/**
  1. ;input:
  1. ; BPDFLT1 - default selection (optional)
  1. ;add comment
  1. ;the user can select
  1. ; a patient - comment will be added to all claims
  1. ; a claim - comment will be added only to this claim
  1. ADDCMT ;*/
  1. N BPRET,BPSEL,BP59ARR,BPRCMNT,BP59,BPNOW,BPLCK,BPREC,BPDFLT1
  1. I '$D(@(VALMAR)) Q
  1. D FULL^VALM1
  1. ;select an item
  1. W !,"Enter the line number for which you wish to Add comments."
  1. S BPDFLT1=$G(^TMP("BPSCMT",$J,"VALM","SELLN"))
  1. S BPDFLT1=$P(BPDFLT1,U,6)_"."_$P(BPDFLT1,U,7)
  1. S BPSEL=$$ASKLINE^BPSSCRU4("Select item","PC","Please select Patient Line to add a comment to all RXs or a SINGLE RXs",$G(BPDFLT1))
  1. I BPSEL<1 S VALMBCK="R" Q
  1. ;if single claim
  1. I $P(BPSEL,U,7)>0 S BP59ARR(+$P(BPSEL,U,4))=""
  1. E D MKPATARR^BPSCMT(VALMAR,+$P(BPSEL,U,6),.BP59ARR)
  1. S BPRCMNT=$$COMMENT^BPSSCRCL("Enter Comment",60)
  1. I (BPRCMNT="^")!($L(BPRCMNT)=0)!(BPRCMNT?1" "." ") Q
  1. S BP59=0
  1. F S BP59=$O(BP59ARR(BP59)) Q:+BP59=0 D
  1. . N BPDA,BPERR,%
  1. . D NOW^%DTC
  1. . S BPNOW=%
  1. . L +^BPST(9002313.59111,+BP59):10
  1. . S BPLCK=$T
  1. . I 'BPLCK Q ;quit
  1. . D INSITEM(9002313.59111,+BP59,BPNOW)
  1. . S BPREC=$O(^BPST(BP59,11,"B",BPNOW,0))
  1. . I BPREC>0 D
  1. . . S BPDA(9002313.59111,BPREC_","_BP59_",",.02)=+$G(DUZ)
  1. . . S BPDA(9002313.59111,BPREC_","_BP59_",",.03)=$G(BPRCMNT)
  1. . . I +$G(BPSCMTRX)=1 S BPDA(9002313.59111,BPREC_","_BP59_",",.04)=1
  1. . . D FILE^DIE("","BPDA","BPERR")
  1. . I BPLCK L -^BPST(9002313.59111,+BP59)
  1. D REDRWCMT^BPSCMT ;update the content of the screen and display it
  1. S ^TMP("BPSSCR",$J,"VALM","UPDATE")=1
  1. Q
  1. ;
  1. ;/**
  1. ;BPSFILE - subfile# (9002313.59111) for comment
  1. ;BPIEN - ien for file in which the new subfile entry will be inserted
  1. ;BPVAL01 - .01 value for the new entry
  1. INSITEM(BPSFILE,BPIEN,BPVAL01) ;*/
  1. N BPSSI,BPIENS,BPFDA,BPER
  1. S BPIENS="+1,"_BPIEN_","
  1. S BPFDA(BPSFILE,BPIENS,.01)=BPVAL01
  1. D UPDATE^DIE("","BPFDA","BPSSI","BPER")
  1. I $D(BPER) D BMES^XPDUTL(BPER("DIERR",1,"TEXT",1))
  1. Q
  1. ;
  1. ;Function to return username data from NEW PERSON file VA(200)
  1. ; Parameter
  1. ; BPSDUZ - IEN of NEW PERSON file
  1. ;
  1. ; Returns
  1. ; Username in format of Lastname, Firstname MI
  1. USERNAM(BPSDUZ) ; Return username from NEW PERSON file
  1. N BPSNMI,BPSNMO
  1. I '$G(BPSDUZ) Q ""
  1. S BPSNMI=$$VA200NM^BPSJUTL(+BPSDUZ,"")
  1. I $G(BPSNMI)="" Q ""
  1. Q:$P(BPSNMI,U)="" ""
  1. S BPSNMO=$P(BPSNMI,U)
  1. Q:$P(BPSNMI,U,2)="" BPSNMO
  1. S BPSNMO=BPSNMO_", "_$P(BPSNMI,U,2)
  1. Q:$P(BPSNMI,U,3)="" BPSNMO
  1. S BPSNMO=BPSNMO_" "_$E($P(BPSNMI,U,3),1)
  1. Q BPSNMO