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

PXCEAE1 ;ISL/dee,ISA/KWP - Builds the List Manager display of a visit and related v-files ;6/20/96
 ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,73**;Aug 12, 1996
 ;; ;
 Q
 ;
BUILD(VISITIEN,AEVIEW,ARRAY,ARRAYIX) ;
 ;AEVIEW is "B" for brief display and "D" for expanded display.
 I '$D(^AUPNVSIT(VISITIEN)) S VALMBCK="Q" Q
 N PXCECNT
 D FULL^VALM1
 D CLEAN^VALM10
 K @ARRAYIX
 S (VALMCNT,PXCECNT)=0
 ;
 ;
 N IEN,FILE,VFILE,VROUTINE
 F FILE="SIT","CSTP","PRV","POV","CPT","TRT","IMM","PED","SK","HF","XAM" D
 . S VROUTINE="PXCE"_$S(FILE="IMM":"VIMM",1:FILE)
 . S VFILE=$P($T(FORMAT^@VROUTINE),"~",5)
 . I FILE="SIT" D
 .. S IEN=VISITIEN
 .. D AFILE(IEN,FILE,VFILE,VROUTINE,ARRAY,ARRAYIX,.VALMCNT,.PXCECNT,AEVIEW)
 .. S VALMCNT=VALMCNT+1
 .. S @ARRAY@(VALMCNT,0)=""
 . E  D
 .. S IEN=""
 .. F  S IEN=$O(@VFILE@("AD",VISITIEN,IEN)) Q:'IEN  D AFILE(IEN,FILE,VFILE,VROUTINE,ARRAY,ARRAYIX,.VALMCNT,.PXCECNT,AEVIEW)
 S @ARRAYIX@(0)=PXCECNT
 I VALMCNT=0 S VALMBCK="Q"
 Q
 ;
AFILE(IEN,FILE,VFILE,VROUTINE,ARRAY,ARRAYIX,VALMCNT,PXCECNT,AEVIEW) ;
 N ENTRY,NODE,NODES,NODECNT
 S PXCECNT=PXCECNT+1
 S NODES=$P($T(FORMAT^@VROUTINE),"~",3)
 F NODECNT=1:1 S NODE=$P(NODES,",",NODECNT) Q:NODE']""  S ENTRY(NODE)=$G(@VFILE@(IEN,NODE))
 D DISPLAY(.ENTRY,VROUTINE,ARRAY,ARRAYIX,.VALMCNT,PXCECNT,AEVIEW)
 I FILE="SIT" S @ARRAYIX@(PXCECNT)=VISITIEN_"^VST"
 E  S @ARRAYIX@(PXCECNT)=IEN_"^"_FILE
 Q
 ;
DISPLAY(ENTRY,PXCECODE,ARRAY,ARRAYIX,LINE,COUNT,VIEW) ; -- display the data
 N PXCEFILE,PXCELINE,PXCETEXT,PXCEINT,PXCEEXT
 S PXCEFILE=$P($T(FORMAT^@PXCECODE),"~",2)
 F PXCELINE=1:1 S PXCETEXT=$P($T(FORMAT+PXCELINE^@PXCECODE),";;",2) Q:PXCETEXT']""  D
 . S (PXCEEXT,PXCEINT)=$P(ENTRY($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))
 . I PXCETEXT'["CPT Modifier",PXCEINT="" Q  ;Q:PXCEINT=""
 . Q:$P(PXCETEXT,"~",10)="N"
 . I VIEW'="D",$P(PXCETEXT,"~",10)="D" Q
 . I PXCECODE="PXCECSTP",$P(PXCETEXT,"~",3)=.01 Q
 . I $P(PXCETEXT,"~",6)]"" D  Q:PXCEEXT=""
 .. ;I PXCECODE["CPT",$P(PXCETEXT,"~",6)["DNAR" B  
 .. S @("PXCEEXT="_$P(PXCETEXT,"~",6)_"("""_$S($P(PXCETEXT,"~",3)=.01:ENTRY($P(PXCETEXT,"~",1)),1:PXCEINT)_""")")
 . E  D
 .. N PXCEDILF,DIERR,PXCEI
 .. S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
 .. S PXCEEXT=$S('$D(DIERR):PXCEEXT,1:PXCEINT)
 . S TEMP=PXCEEXT
 . F PXI=1:1 Q:$P(TEMP,"^",PXI)=""  S PXCEEXT=$P(TEMP,"^",PXI) D ADDLINE
 Q
ADDLINE ;
 S LINE=LINE+1
 I PXCELINE=1!(PXCECODE="PXCECSTP") S @ARRAY@(LINE,0)=$J(COUNT,3)_" "
 E  S @ARRAY@(LINE,0)="    "
 S @ARRAY@(LINE,0)=@ARRAY@(LINE,0)_$P(PXCETEXT,"~",5)
 I ($L(@ARRAY@(LINE,0))+$L(PXCEEXT))'>80 D
 . S @ARRAY@(LINE,0)=@ARRAY@(LINE,0)_PXCEEXT
 E  D
 . N PXCEWRAP,PXCECOUN,PXCEHEAD
 . S PXCEHEAD=$L(@ARRAY@(LINE,0))
 . D WRAP^PXCEVFI4(PXCEEXT,80-PXCEHEAD,.PXCEWRAP)
 . S @ARRAY@(LINE,0)=@ARRAY@(LINE,0)_$G(PXCEWRAP(1))
 . S PXCECOUN=1
 . F  S PXCECOUN=$O(PXCEWRAP(PXCECOUN)) Q:PXCECOUN']""  D
 .. S LINE=LINE+1
 .. S @ARRAY@(LINE,0)=$J("",PXCEHEAD)_PXCEWRAP(PXCECOUN)
 Q
 ;