source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXCEAE1.m@ 1150

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

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1PXCEAE1 ;ISL/dee,ISA/KWP - Builds the List Manager display of a visit and related v-files ;6/20/96
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,73**;Aug 12, 1996
3 ;; ;
4 Q
5 ;
6BUILD(VISITIEN,AEVIEW,ARRAY,ARRAYIX) ;
7 ;AEVIEW is "B" for brief display and "D" for expanded display.
8 I '$D(^AUPNVSIT(VISITIEN)) S VALMBCK="Q" Q
9 N PXCECNT
10 D FULL^VALM1
11 D CLEAN^VALM10
12 K @ARRAYIX
13 S (VALMCNT,PXCECNT)=0
14 ;
15 ;
16 N IEN,FILE,VFILE,VROUTINE
17 F FILE="SIT","CSTP","PRV","POV","CPT","TRT","IMM","PED","SK","HF","XAM" D
18 . S VROUTINE="PXCE"_$S(FILE="IMM":"VIMM",1:FILE)
19 . S VFILE=$P($T(FORMAT^@VROUTINE),"~",5)
20 . I FILE="SIT" D
21 .. S IEN=VISITIEN
22 .. D AFILE(IEN,FILE,VFILE,VROUTINE,ARRAY,ARRAYIX,.VALMCNT,.PXCECNT,AEVIEW)
23 .. S VALMCNT=VALMCNT+1
24 .. S @ARRAY@(VALMCNT,0)=""
25 . E D
26 .. S IEN=""
27 .. F S IEN=$O(@VFILE@("AD",VISITIEN,IEN)) Q:'IEN D AFILE(IEN,FILE,VFILE,VROUTINE,ARRAY,ARRAYIX,.VALMCNT,.PXCECNT,AEVIEW)
28 S @ARRAYIX@(0)=PXCECNT
29 I VALMCNT=0 S VALMBCK="Q"
30 Q
31 ;
32AFILE(IEN,FILE,VFILE,VROUTINE,ARRAY,ARRAYIX,VALMCNT,PXCECNT,AEVIEW) ;
33 N ENTRY,NODE,NODES,NODECNT
34 S PXCECNT=PXCECNT+1
35 S NODES=$P($T(FORMAT^@VROUTINE),"~",3)
36 F NODECNT=1:1 S NODE=$P(NODES,",",NODECNT) Q:NODE']"" S ENTRY(NODE)=$G(@VFILE@(IEN,NODE))
37 D DISPLAY(.ENTRY,VROUTINE,ARRAY,ARRAYIX,.VALMCNT,PXCECNT,AEVIEW)
38 I FILE="SIT" S @ARRAYIX@(PXCECNT)=VISITIEN_"^VST"
39 E S @ARRAYIX@(PXCECNT)=IEN_"^"_FILE
40 Q
41 ;
42DISPLAY(ENTRY,PXCECODE,ARRAY,ARRAYIX,LINE,COUNT,VIEW) ; -- display the data
43 N PXCEFILE,PXCELINE,PXCETEXT,PXCEINT,PXCEEXT
44 S PXCEFILE=$P($T(FORMAT^@PXCECODE),"~",2)
45 F PXCELINE=1:1 S PXCETEXT=$P($T(FORMAT+PXCELINE^@PXCECODE),";;",2) Q:PXCETEXT']"" D
46 . S (PXCEEXT,PXCEINT)=$P(ENTRY($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))
47 . I PXCETEXT'["CPT Modifier",PXCEINT="" Q ;Q:PXCEINT=""
48 . Q:$P(PXCETEXT,"~",10)="N"
49 . I VIEW'="D",$P(PXCETEXT,"~",10)="D" Q
50 . I PXCECODE="PXCECSTP",$P(PXCETEXT,"~",3)=.01 Q
51 . I $P(PXCETEXT,"~",6)]"" D Q:PXCEEXT=""
52 .. ;I PXCECODE["CPT",$P(PXCETEXT,"~",6)["DNAR" B
53 .. S @("PXCEEXT="_$P(PXCETEXT,"~",6)_"("""_$S($P(PXCETEXT,"~",3)=.01:ENTRY($P(PXCETEXT,"~",1)),1:PXCEINT)_""")")
54 . E D
55 .. N PXCEDILF,DIERR,PXCEI
56 .. S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
57 .. S PXCEEXT=$S('$D(DIERR):PXCEEXT,1:PXCEINT)
58 . S TEMP=PXCEEXT
59 . F PXI=1:1 Q:$P(TEMP,"^",PXI)="" S PXCEEXT=$P(TEMP,"^",PXI) D ADDLINE
60 Q
61ADDLINE ;
62 S LINE=LINE+1
63 I PXCELINE=1!(PXCECODE="PXCECSTP") S @ARRAY@(LINE,0)=$J(COUNT,3)_" "
64 E S @ARRAY@(LINE,0)=" "
65 S @ARRAY@(LINE,0)=@ARRAY@(LINE,0)_$P(PXCETEXT,"~",5)
66 I ($L(@ARRAY@(LINE,0))+$L(PXCEEXT))'>80 D
67 . S @ARRAY@(LINE,0)=@ARRAY@(LINE,0)_PXCEEXT
68 E D
69 . N PXCEWRAP,PXCECOUN,PXCEHEAD
70 . S PXCEHEAD=$L(@ARRAY@(LINE,0))
71 . D WRAP^PXCEVFI4(PXCEEXT,80-PXCEHEAD,.PXCEWRAP)
72 . S @ARRAY@(LINE,0)=@ARRAY@(LINE,0)_$G(PXCEWRAP(1))
73 . S PXCECOUN=1
74 . F S PXCECOUN=$O(PXCEWRAP(PXCECOUN)) Q:PXCECOUN']"" D
75 .. S LINE=LINE+1
76 .. S @ARRAY@(LINE,0)=$J("",PXCEHEAD)_PXCEWRAP(PXCECOUN)
77 Q
78 ;
Note: See TracBrowser for help on using the repository browser.