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

PXCEAE1.m

Go to the documentation of this file. 
  1. PXCEAE1 ;ISL/dee,ISA/KWP,SLC/ajb - Builds the List Manager display of a visit and related v-files ;12/23/2020
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,73,199,201,210,215,211**;Aug 12, 1996;Build 454
  1.  ;; ;
  1.  Q
  1.  ;
  1. BUILD(VISITIEN,AEVIEW,ARRAY,ARRAYIX) ;
  1.  ;AEVIEW is "B" for brief display and "D" for expanded display.
  1.  I '$D(^AUPNVSIT(VISITIEN)) S VALMBCK="Q" Q
  1.  N PXCECNT
  1.  D FULL^VALM1
  1.  D CLEAN^VALM10
  1.  K @ARRAYIX
  1.  S (VALMCNT,PXCECNT)=0
  1.  ;
  1.  ;
  1.  N IEN,FILE,VFILE,VROUTINE
  1.  F FILE="SIT","CSTP","PRV","POV","CPT","TRT","IMM","PED","SK","HF","XAM","ICR","SC" D  ; PX*1*215
  1.  . S VROUTINE="PXCE"_$S(FILE="IMM":"VIMM",1:FILE)
  1.  . S VFILE=$P($T(FORMAT^@VROUTINE),"~",5)
  1.  . I FILE="SIT" D
  1.  .. S IEN=VISITIEN
  1.  .. D AFILE(IEN,FILE,VFILE,VROUTINE,ARRAY,ARRAYIX,.VALMCNT,.PXCECNT,AEVIEW)
  1.  .. S VALMCNT=VALMCNT+1
  1.  .. S @ARRAY@(VALMCNT,0)=""
  1.  . E  D
  1.  .. S IEN=""
  1.  .. F  S IEN=$O(@VFILE@("AD",VISITIEN,IEN)) Q:'IEN  D AFILE(IEN,FILE,VFILE,VROUTINE,ARRAY,ARRAYIX,.VALMCNT,.PXCECNT,AEVIEW)
  1.  S @ARRAYIX@(0)=PXCECNT
  1.  I VALMCNT=0 S VALMBCK="Q"
  1.  Q
  1.  ;
  1. AFILE(IEN,FILE,VFILE,VROUTINE,ARRAY,ARRAYIX,VALMCNT,PXCECNT,AEVIEW) ;
  1.  N ENTRY,NODE,NODES,NODECNT,PNARR
  1.  S PXCECNT=PXCECNT+1
  1.  S NODES=$P($T(FORMAT^@VROUTINE),"~",3)
  1.  F NODECNT=1:1 S NODE=$P(NODES,",",NODECNT) Q:NODE']""  S ENTRY(NODE)=$G(@VFILE@(IEN,NODE))
  1.  ;Check for bad provider narratives.
  1.  I FILE="CPT" D
  1.  . S PNARR=$P(ENTRY(0),U,4)
  1.  . I PNARR'>0 D ONEVCPT^PXPNARR(VISITIEN,IEN,.ENTRY)
  1.  I FILE="POV" D
  1.  . S PNARR=$P(ENTRY(0),U,4)
  1.  . I PNARR'>0 D ONEVPOV^PXPNARR(VISITIEN,IEN,.ENTRY)
  1.  D DISPLAY(.ENTRY,VROUTINE,ARRAY,ARRAYIX,.VALMCNT,PXCECNT,AEVIEW)
  1.  I FILE="SIT" S @ARRAYIX@(PXCECNT)=VISITIEN_"^VST"
  1.  E  S @ARRAYIX@(PXCECNT)=IEN_"^"_FILE
  1.  Q
  1.  ;
  1. DISPLAY(ENTRY,PXCECODE,ARRAY,ARRAYIX,LINE,COUNT,VIEW) ; -- display the data
  1.  N PXCEDT,PXCEINT,PXCEEXT,PXCEFILE,PXCELINE,PXCETEXT
  1.  S PXCEFILE=$P($T(FORMAT^@PXCECODE),"~",2)
  1.  ;Set the date and time to the Event Date and Time, if it exists,
  1.  ;otherwise set it to the Visit Date and Time.
  1.  S PXCEDT=$P($G(ENTRY(12)),U,1)
  1.  I PXCEDT="" S PXCEDT=$P(^AUPNVSIT(PXCEVIEN,0),U,1)
  1.  F PXCELINE=1:1 S PXCETEXT=$P($T(FORMAT+PXCELINE^@PXCECODE),";;",2) Q:PXCETEXT']""  D
  1.  . ; save original PXCETEXT for multiple diagnosis ouput ; ajb
  1.  . I VFILE="^AUPNVIMM",+PXCETEXT=3 N TMPTXT S TMPTXT=PXCETEXT ; ajb
  1.  . I VFILE="^AUPNVIMM",+PXCETEXT=2 N TMPTXT S TMPTXT=PXCETEXT ; PX*1*210
  1.  . S (PXCEEXT,PXCEINT)=$P(ENTRY($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))
  1.  . ; get entries from diagnosis multiple ; ajb
  1.  . I VFILE="^AUPNVIMM",+PXCETEXT=3 D  S:PXCEINT="" PXCEINT="^" S PXCEEXT=PXCEINT ; ajb
  1.  . . N CNT,NIEN S (CNT,NIEN)=0 F  S NIEN=$O(^AUPNVIMM(IEN,3,NIEN)) Q:'+NIEN  D  ; ajb
  1.  . . . S CNT=CNT+1,$P(PXCEINT,U,CNT)=$G(^AUPNVIMM(IEN,3,NIEN,0)) ; ajb
  1.  . ; ajb - above / PX*1*210 - below
  1.  . ; get entries from vis offered/given to patient multiple ; PX*1*210
  1.  . I VFILE="^AUPNVIMM",+PXCETEXT=2 D  S:PXCEINT="" PXCEINT="^" S PXCEEXT=PXCEINT
  1.  . . N CNT,NIEN S (CNT,NIEN)=0 F  S NIEN=$O(^AUPNVIMM(IEN,2,NIEN)) Q:'+NIEN  D
  1.  . . . S CNT=CNT+1,$P(PXCEINT,U,CNT)=$P($G(^AUPNVIMM(IEN,2,NIEN,0)),"^")
  1.  . ; PX*1*210
  1.  . I PXCETEXT'["CPT Modifier",PXCEINT="" Q  ;Q:PXCEINT=""
  1.  . Q:$P(PXCETEXT,"~",10)="N"
  1.  . I VIEW'="D",$P(PXCETEXT,"~",10)="D" Q
  1.  . I PXCECODE="PXCECSTP",$P(PXCETEXT,"~",3)=.01 Q
  1.  . I VFILE="^AUPNVIMM",+PXCETEXT=2,+PXCEINT D VIS Q
  1.  . I $P(PXCETEXT,"~",6)]"" D  Q:PXCEEXT=""
  1.  .. S @("PXCEEXT="_$P(PXCETEXT,"~",6)_"("""_$S($P(PXCETEXT,"~",3)=.01:ENTRY($P(PXCETEXT,"~",1)),1:PXCEINT)_""",PXCEDT)")
  1.  . E  D
  1.  .. N PXCEDILF,DIERR,PXCEI
  1.  .. S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
  1.  .. S PXCEEXT=$S('$D(DIERR):PXCEEXT,1:PXCEINT)
  1.  . ; get ICD info for multiple diagnosis ; ajb
  1.  . I VFILE="^AUPNVIMM",+PXCETEXT=3,+PXCEINT D  ; ajb
  1.  . . S PXCEEXT="" ; ajb
  1.  . . N CNT F CNT=1:1:$L(PXCEINT,U) S $P(PXCEEXT,U,CNT)=$$DISPLY01^PXCEPOV($P(PXCEINT,U,CNT),PXCEDT) ; ajb
  1.  . N TEMP S TEMP=PXCEEXT
  1.  . N PXI F PXI=1:1 Q:$P(TEMP,"^",PXI)=""  S PXCEEXT=$P(TEMP,"^",PXI) D ADDLINE S:+$D(TMPTXT) PXCETEXT=TMPTXT ; replace modified with original for multiple diagnosis ; ajb
  1.  Q
  1. ADDLINE ;
  1.  S LINE=LINE+1
  1.  I PXCELINE=1!(PXCECODE="PXCECSTP") S @ARRAY@(LINE,0)=$J(COUNT,3)_" "
  1.  E  S @ARRAY@(LINE,0)="    "
  1.  S @ARRAY@(LINE,0)=@ARRAY@(LINE,0)_$P(PXCETEXT,"~",5)
  1.  I ($L(@ARRAY@(LINE,0))+$L(PXCEEXT))'>80 D
  1.  . S @ARRAY@(LINE,0)=@ARRAY@(LINE,0)_PXCEEXT
  1.  E  D
  1.  . N PXCEWRAP,PXCECOUN,PXCEHEAD
  1.  . S PXCEHEAD=$L(@ARRAY@(LINE,0))
  1.  . D WRAP^PXCEVFI4(PXCEEXT,80-PXCEHEAD,.PXCEWRAP)
  1.  . S @ARRAY@(LINE,0)=@ARRAY@(LINE,0)_$G(PXCEWRAP(1))
  1.  . S PXCECOUN=1
  1.  . F  S PXCECOUN=$O(PXCEWRAP(PXCECOUN)) Q:PXCECOUN']""  D
  1.  .. S LINE=LINE+1
  1.  .. S @ARRAY@(LINE,0)=$J("",PXCEHEAD)_PXCEWRAP(PXCECOUN)
  1.  Q
  1. VIS ; get vaccine information statement info ; adm
  1.  S PXCEEXT=""
  1.  N CNT F CNT=1:1:$L(PXCEINT,U) S $P(PXCEEXT,U,CNT)=$$DISPVIS^PXCEVIS($P(PXCEINT,U,CNT))
  1.  N TEMP S TEMP=PXCEEXT
  1.  N PXI F PXI=1:1 Q:$P(TEMP,"^",PXI)=""  S PXCEEXT=$P(TEMP,"^",PXI) D ADDLINE S:+$D(TMPTXT) PXCETEXT=TMPTXT
  1.  Q
  1.  ;