source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBUCUTL5.m@ 949

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

initial load of WorldVistAEHR
File size: 5.5 KB
Line 
1FBUCUTL5 ;ALBISC/TET - UTILITY CONTINUATION (SET DISPLAY) ;6/28/01
2 ;;3.5;FEE BASIS;**32**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4DISP7(IX,IEN,FBO,FB1725R) ;set array for display from file 162.7
5 ;INPUT: order no. of status (FBO), xref (IX) and either veteran or vendor ien (IEN) and optionally mill bill screening criteria (FB1725R)
6 ; FBO is either 0 for all status' for a patient/vendor or
7 ; in string format, delimited by "^" EG: ("10^50^")
8 ; FB1725 = (optional) mill bill screening criteria with value
9 ; "M" for just mill bill claims
10 ; "N" for just non-mill bill claims
11 ; "A" (or null) for all claims
12 ;VARIABLE PL is set to the piece length of order string,
13 ; if fbo = 0 set to 2; if pl>1 status is displayed
14 ; SON = status order number
15 ; FBORDER = specific order from fbo string
16 ; FBMC = master claim ien with Primary or Secondary designation
17 ;OUTPUT: FBAR( array => ien;name(vet or ven)^name(ven or vet)^fee program^date of claim^status (if status not passed - pl'>1)
18 ; FBAR = display count in array;piece positions for display (only if count)
19 D:$D(XRTL) T0^%ZOSV ;start monitor
20 K ^TMP("FBAR",$J) N FBAR,FBDA,FBDCT,FBMC,FBOMC,FBORDER,FBSP,FBSET,P,PL,SON,Z S FBDCT=0,FBO=$S('+$G(FBO):$$FBO^FBUCUTL4(),1:FBO),PL=($L(FBO,"^")-1)
21 S FB1725R=$G(FB1725R) ; optional parameter
22 S FBOMC=0,FBMC="" F S FBMC=$O(^FB583(IX,IEN,FBMC)) Q:FBMC']"" D
23 . S FBSET=$S(FBOMC'=+FBMC:1,1:0)
24 . F P=1:1:PL S SON=$P(FBO,U,P) Q:SON']"" D
25 . . S FBDA=0 F S FBDA=$O(^FB583(IX,IEN,FBMC,SON,FBDA)) Q:'FBDA I $$MBSCR(FB1725R,FBDA) D DA(FBDA,IX,.FBDCT,FBMC):FBSET,DA1:'FBSET S FBOMC=+FBMC
26 D FBAR(FBDCT)
27 S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ;stop monitor
28 Q
29DA(FBDA,IX,FBDCT,FBMC,Z) ;get ien in 162.7 and set array; also called from enter tag in fbuclink
30 ;INPUT: FBDA = internal entry number of unauthorized claim
31 ; IX = cross-reference, APMS is from fbuclink
32 ; FBDCT = counter
33 ; FBMC = master claim ien
34 ; Z = (optional) zero node of unauthorized claim
35 S:$G(Z)']"" Z=$G(^FB583(FBDA,0)) I Z]"" D
36 .S FBAR=FBDA_";"_$S(IX'="AVMS":($E($$VET^FBUCUTL($P(Z,U,4)),1,12)_U_$E($$VEN^FBUCUTL($P(Z,U,3)),1,12)),1:($E($$VEN^FBUCUTL($P(Z,U,3)),1,12)_U_$E($$VET^FBUCUTL($P(Z,U,4)),1,12)))
37 .S FBAR=FBAR_U_$E($$PROG^FBUCUTL($P(Z,U,2)),1,12)_U_$$DATX^FBAAUTL($P(Z,U))_U_$E($P($$PTR^FBUCUTL("^FB(162.92,",$P(Z,U,24)),U),1,16)_U_"!"_U_"TREATMENT FROM: "_$$DATX^FBAAUTL(+$P(Z,U,5))_U_"TREATMENT TO: "_$$DATX^FBAAUTL(+$P(Z,U,6))
38 .I $P(Z,U,20)'=FBDA,+$G(FBMC) S FBAR=FBAR_U_"PRIMARY CLAIM: "_$$DATX^FBAAUTL(+$P($G(^FB583(+FBMC,0)),U))
39 .S FBDCT=FBDCT+1,^TMP("FBAR",$J,FBDCT)=FBAR
40 Q
41DA1 ;if same set, set node differently
42 S Z=$G(^FB583(FBDA,0)) I Z]"" D
43 .S:IX'="AVMS" FBAR=FBDA_";"_$S(FBMC["P":"",1:" ")_$$PAD^FBUCUTL4(12,$E($$VEN^FBUCUTL($P(Z,U,3)),1,12)," ",2)
44 .S:IX="AVMS" FBAR=FBDA_";"_$S(FBMC["P":"",1:" ")_$$PAD^FBUCUTL4(12,$E($$VET^FBUCUTL($P(Z,U,4)),1,12)," ",2)
45 .;S FBAR=FBDA_"; "_FBAR
46 .S FBAR=FBAR_U_" "_$$PAD^FBUCUTL4(12,$E($$PROG^FBUCUTL($P(Z,U,2)),1,12)," ",2)_" "_$$DATX^FBAAUTL($P(Z,U))_" "_$$PAD^FBUCUTL4(16,$E($P($G(^FB(162.92,$$STATUS^FBUCUTL(SON),0)),U),1,16)," ",2)
47 .S FBAR=FBAR_" <"_$$DATX^FBAAUTL(+$P($G(^FB583(+FBMC,0)),U))_">"
48 .S FBDCT=FBDCT+1,^TMP("FBAR",$J,FBDCT)=FBAR
49 Q
50FBAR(FBDCT) ;set fbar node, also called from fbuclink
51 ;INPUT: FBDCT = number of entries in global array
52 ;OUTPUT: FBAR = fbar node
53 ; sets tmp("fbar",$j,"fbar")=# entries;piece positions
54 N E S:$G(FBDCT)']"" FBDCT=0 S FBAR=FBDCT I FBDCT S E="5^20^35^52^63^6^33^57^",FBAR=FBAR_";"_E
55 S ^TMP("FBAR",$J,"FBAR")=FBAR
56 Q
57DISP8(FBDA) ;set array for display from file 162.8
58 ;INPUT: FBDA = ien of unauthorized claim (file 162.7)
59 ;OUTPUT: FBAR( array => ien of file 162.8;.01 from file 162.93^
60 K ^TMP("FBAR",$J) N FBAR,FBDCT,FBDT,FBI,Z
61 S (FBDT,FBDCT)=0 F S FBDT=$O(^FBAA(162.8,"ACD",FBDA,FBDT)) Q:'FBDT D
62 .S FBI=0 F S FBI=$O(^FBAA(162.8,"ACD",FBDA,FBDT,FBI)) Q:'FBI S Z=$G(^FBAA(162.8,+FBI,0)) I Z]"",'$P(Z,U,5) S FBDCT=FBDCT+1,FBAR=FBI_";"_$P($G(^FB(162.93,+$P(Z,U,3),0)),U) D
63 ..I $P(Z,U,4)]"" S FBAR=FBAR_U_"!"_U_$P(Z,U,4)
64 ..S ^TMP("FBAR",$J,FBDCT)=FBAR
65 S FBAR=FBDCT I FBDCT S FBAR=FBAR_";5^6^"
66 S ^TMP("FBAR",$J,"FBAR")=FBAR
67 Q
68DISP9(FN,IG) ;set array for display from files 162.9*
69 ;INPUT: FN = file number
70 ; IG = ignore screen (optional)
71 ;OUTPUT: FBAR( array => ien;.01 from file^
72 ; FBAR = display count in array;piece positions for display (only if count)
73 K ^TMP("FBAR",$J) N FBAR,FBDA,FBDCT,Z S IG=+$G(IG)
74 S (FBDA,FBDCT)=0 F S FBDA=$O(^FB(FN,FBDA)) Q:'FBDA S Z=$G(^(FBDA,0)) I Z]"",IG!('IG&($P(Z,U,2))) S FBDCT=FBDCT+1,FBAR=FBDA_";"_$P(Z,U),^TMP("FBAR",$J,FBDCT)=FBAR
75 S FBAR=FBDCT I FBDCT S FBAR=FBAR_";"_5_U
76 S ^TMP("FBAR",$J,"FBAR")=FBAR
77 Q
78DISP92 ;display status, in order sequence
79 ;OUTPUT: data in tmp("fbar",$j)
80 K ^TMP("FBAR",$J) N FBAR,FBDCT,FBI,FBO,Z S (FBDCT,FBO)=0
81 F S FBO=$O(^FB(162.92,"AO",FBO)) Q:'FBO S FBI=0,FBI=+$O(^FB(162.92,"AO",FBO,0)) I FBI S Z=$G(^FB(162.92,FBI,0)) I Z]"" S FBDCT=FBDCT+1,FBAR=FBI_";"_$P(Z,U),^TMP("FBAR",$J,FBDCT)=FBAR
82 S FBAR=FBDCT I FBDCT S FBAR=FBAR_";5^"
83 S ^TMP("FBAR",$J,"FBAR")=FBAR
84 Q
85MBSCR(FB1725R,FBDA) ; Mill Bill Screen
86 ;INPUT: FB1725R - criteria code (M:just mill bill, N:just non-mill bill,
87 ; A:all, null:all)
88 ; FBDA - internal entry number of unauthorized claim
89 ;RETURN: true if claim meets criteria or false if it does not
90 N FBRET
91 S FBRET=1 ; initial value
92 I FB1725R="M",$P($G(^FB583(FBDA,0)),U,28)'=1 S FBRET=0
93 I FB1725R="N",$P($G(^FB583(FBDA,0)),U,28)=1 S FBRET=0
94 Q FBRET
Note: See TracBrowser for help on using the repository browser.