source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSCMT01.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.2 KB
Line 
1BPSCMT01 ;BHAM ISC/SS - ECME ADD/VIEW COMMENTS ;05-APR-05
2 ;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;USER SCREEN
5 Q
6 ;
7ADD ;entry point for Add option in Add/View screen
8 ;full screen mode
9 D FULL^VALM1
10 D ADDCMT
11 S VALMBCK="R"
12 Q
13 ;make element for the patient
14 ;BPLINE - line number in LM ARRAY (by ref)
15 ;BPTMP - VALMAR (TMP global for LM)
16 ;BPDFN - patient's DFN
17 ;BPSINSUR - ;patient's insurance ien^name^phone
18 ;BPLMIND - passed by ref - current patient(/insurance) index ( to make 1, 2,etc)
19 ;BPDRIND - passed by ref - current claim level index ( to make .1, .2, .10,... .20,... )
20 ;BPPREV - to store previous data to update patient summary line
21MKPATELM(BPLINE,BPTMP,BPDFN,BPSINSUR,BPLMIND,BPDRIND,BPPREV) ;*/
22 N BPSSTR,BPLNS,BPSTAT
23 ;PATIENT SUMMARY level
24 ;-------- first process previous patient & insurance group
25 ;determine patient summary statuses for the previous "patient" group
26 ;update the record for previous patient summary after we went thru all his claims
27 I BPLMIND>0,+BPPREV=BPLMIND D UPDPREV(BPTMP,BPLMIND,BPPREV)
28 ;process new "patient & insurance" group ------------------
29 S BPDRIND=0
30 S BPLMIND=(BPLMIND\1)+1
31 ;save the all necessary data for the patient & insurance to use as previous for STAT4PAT later on
32 S BPPREV=BPLMIND_U_BPLINE_U_BPDFN_U_$$PATINF^BPSSCR02(BPDFN,BPSINSUR)_U_(+BPSINSUR)
33 S BPSSTR=$$LJ^BPSSCR02(BPLMIND,4)_$P(BPPREV,U,4)
34 D SAVEARR^BPSSCR02(BPTMP,BPLMIND,BPDRIND,BPDFN,0,BPLINE,BPSSTR,+BPSINSUR)
35 S BPLINE=BPLINE+1
36 Q
37 ;
38 ;/**
39 ;update patient summary info in LM array
40UPDPREV(BPTMP,BPLMIND,BPPREV) ;
41 N BPSSTR
42 ;update the record for previous patient summary after we went thru all his claims
43 S BPSSTR=$$LJ^BPSSCR02(BPLMIND,4)_$P(BPPREV,U,4)_" "_$$STAT4PAT^BPSSCR02(BPLMIND)
44 D SAVEARR^BPSSCR02(BPTMP,BPLMIND,0,+$P(BPPREV,U,3),0,+$P(BPPREV,U,2),BPSSTR,+$P(BPPREV,U,5))
45 Q
46 ;/**
47 ;make array element for a claim
48 ;BPLINE - line number in LM ARRAY (by ref)
49 ;BPTMP - VALMAR (TMP global for LM)
50 ;BP59 - ptr to 9002313.59
51 ;BPDFN - patient's DFN
52 ;BPSINSUR - ;patient's insurance ien
53 ;BPLMIND - passed by ref - current patient(/insurance) index ( to make 1, 2,etc)
54 ;BPDRIND - passed by ref - current claim level index ( to make .1, .2, .10,... .20,... )
55 ;BPPREV - to store previous data to update patient summary line
56MKCLMELM(BPLINE,BPTMP,BP59,BPDFN,BPSINSUR,BPLMIND,BPDRIND,BPPREV) ;*/
57 N BPSSTR,BPLNS,BPSTAT
58 ;CLAIMS level
59 I +$O(@BPTMP@("LMIND",BPLMIND,BPDRIND,BPDFN,0))'=BP59 D
60 . S BPDRIND=BPDRIND+1
61 . S BPSSTR=" "_$$LJ^BPSSCR02(+$P(BPLMIND,".")_"."_BPDRIND,5)_" "_$$CLAIMINF^BPSSCR02(BP59)
62 . D SAVEARR^BPSSCR02(BPTMP,BPLMIND,BPDRIND,BPDFN,BP59,BPLINE,BPSSTR,BPSINSUR)
63 . S BPLINE=BPLINE+1
64 . N BPARR,X
65 . ;use ADDINF^BPSSCR03 to get comments
66 . S BPLNS=$$ADDINF^BPSSCR03(BP59,.BPARR,74,"C")
67 . F X=1:1:BPLNS D
68 . . I $G(BPARR(X))="" Q
69 . . D SAVEARR^BPSSCR02(BPTMP,BPLMIND,BPDRIND,BPDFN,BP59,BPLINE," "_BPARR(X),BPSINSUR)
70 . . S BPLINE=BPLINE+1
71 Q
72 ;/**
73 ;input:
74 ; BPDFLT1 - default selection (optional)
75 ;add comment
76 ;the user can select
77 ; a patient - comment will be added to all claims
78 ; a claim - comment will be added only to this claim
79ADDCMT ;*/
80 N BPRET,BPSEL,BP59ARR,BPRCMNT,BP59,BPNOW,BPLCK,BPREC,BPDFLT1
81 I '$D(@(VALMAR)) Q
82 D FULL^VALM1
83 ;select an item
84 W !,"Enter the line number for which you wish to Add comments."
85 S BPDFLT1=$G(^TMP("BPSCMT",$J,"VALM","SELLN"))
86 S BPDFLT1=$P(BPDFLT1,U,6)_"."_$P(BPDFLT1,U,7)
87 S BPSEL=$$ASKLINE^BPSSCRU4("Select item","PC","Please select Patient Line to add a comment to all RXs or a SINGLE RXs",$G(BPDFLT1))
88 I BPSEL<1 S VALMBCK="R" Q
89 ;if single claim
90 I $P(BPSEL,U,7)>0 S BP59ARR(+$P(BPSEL,U,4))=""
91 E D MKPATARR^BPSCMT(VALMAR,+$P(BPSEL,U,6),.BP59ARR)
92 S BPRCMNT=$$COMMENT^BPSSCRCL("Enter Comment",60)
93 I (BPRCMNT="^")!($L(BPRCMNT)=0)!(BPRCMNT?1" "." ") Q
94 S BP59=0
95 F S BP59=$O(BP59ARR(BP59)) Q:+BP59=0 D
96 . N BPDA,BPERR,%
97 . D NOW^%DTC
98 . S BPNOW=%
99 . L +^BPST(9002313.59111,+BP59):10
100 . S BPLCK=$T
101 . I 'BPLCK Q ;quit
102 . D INSITEM(9002313.59111,+BP59,BPNOW)
103 . S BPREC=$O(^BPST(BP59,11,"B",BPNOW,0))
104 . I BPREC>0 D
105 . . S BPDA(9002313.59111,BPREC_","_BP59_",",.02)=+$G(DUZ)
106 . . S BPDA(9002313.59111,BPREC_","_BP59_",",.03)=$G(BPRCMNT)
107 . . D FILE^DIE("","BPDA","BPERR")
108 . I BPLCK L -^BPST(9002313.59111,+BP59)
109 D REDRWCMT^BPSCMT ;update the content of the screen and display it
110 S ^TMP("BPSSCR",$J,"VALM","UPDATE")=1
111 Q
112 ;
113 ;/**
114 ;BPSFILE - subfile# (9002313.59111) for comment
115 ;BPIEN - ien for file in which the new subfile entry will be inserted
116 ;BPVAL01 - .01 value for the new entry
117INSITEM(BPSFILE,BPIEN,BPVAL01) ;*/
118 N BPSSI,BPIENS,BPFDA,BPER
119 S BPIENS="+1,"_BPIEN_","
120 S BPFDA(BPSFILE,BPIENS,.01)=BPVAL01
121 D UPDATE^DIE("","BPFDA","BPSSI","BPER")
122 I $D(BPER) D BMES^XPDUTL(BPER("DIERR",1,"TEXT",1))
123 Q
124 ;
125 ;Function to return username data from NEW PERSON file VA(200)
126 ; Parameter
127 ; BPSDUZ - IEN of NEW PERSON file
128 ;
129 ; Returns
130 ; Username in format of Lastname, Firstname MI
131USERNAM(BPSDUZ) ; Return username from NEW PERSON file
132 N BPSNMI,BPSNMO
133 I '$G(BPSDUZ) Q ""
134 S BPSNMI=$$VA200NM^BPSJUTL(+BPSDUZ,"")
135 I $G(BPSNMI)="" Q ""
136 Q:$P(BPSNMI,U)="" ""
137 S BPSNMO=$P(BPSNMI,U)
138 Q:$P(BPSNMI,U,2)="" BPSNMO
139 S BPSNMO=BPSNMO_", "_$P(BPSNMI,U,2)
140 Q:$P(BPSNMI,U,3)="" BPSNMO
141 S BPSNMO=BPSNMO_" "_$E($P(BPSNMI,U,3),1)
142 Q BPSNMO
Note: See TracBrowser for help on using the repository browser.