PXCEAE1 ;ISL/dee,ISA/KWP,SLC/ajb - Builds the List Manager display of a visit and related v-files ;12/23/2020
;;1.0;PCE PATIENT CARE ENCOUNTER;**22,73,199,201,210,215,211**;Aug 12, 1996;Build 454
;; ;
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","ICR","SC" D ; PX*1*215
. 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,PNARR
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))
;Check for bad provider narratives.
I FILE="CPT" D
. S PNARR=$P(ENTRY(0),U,4)
. I PNARR'>0 D ONEVCPT^PXPNARR(VISITIEN,IEN,.ENTRY)
I FILE="POV" D
. S PNARR=$P(ENTRY(0),U,4)
. I PNARR'>0 D ONEVPOV^PXPNARR(VISITIEN,IEN,.ENTRY)
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 PXCEDT,PXCEINT,PXCEEXT,PXCEFILE,PXCELINE,PXCETEXT
S PXCEFILE=$P($T(FORMAT^@PXCECODE),"~",2)
;Set the date and time to the Event Date and Time, if it exists,
;otherwise set it to the Visit Date and Time.
S PXCEDT=$P($G(ENTRY(12)),U,1)
I PXCEDT="" S PXCEDT=$P(^AUPNVSIT(PXCEVIEN,0),U,1)
F PXCELINE=1:1 S PXCETEXT=$P($T(FORMAT+PXCELINE^@PXCECODE),";;",2) Q:PXCETEXT']"" D
. ; save original PXCETEXT for multiple diagnosis ouput ; ajb
. I VFILE="^AUPNVIMM",+PXCETEXT=3 N TMPTXT S TMPTXT=PXCETEXT ; ajb
. I VFILE="^AUPNVIMM",+PXCETEXT=2 N TMPTXT S TMPTXT=PXCETEXT ; PX*1*210
. S (PXCEEXT,PXCEINT)=$P(ENTRY($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))
. ; get entries from diagnosis multiple ; ajb
. I VFILE="^AUPNVIMM",+PXCETEXT=3 D S:PXCEINT="" PXCEINT="^" S PXCEEXT=PXCEINT ; ajb
. . N CNT,NIEN S (CNT,NIEN)=0 F S NIEN=$O(^AUPNVIMM(IEN,3,NIEN)) Q:'+NIEN D ; ajb
. . . S CNT=CNT+1,$P(PXCEINT,U,CNT)=$G(^AUPNVIMM(IEN,3,NIEN,0)) ; ajb
. ; ajb - above / PX*1*210 - below
. ; get entries from vis offered/given to patient multiple ; PX*1*210
. I VFILE="^AUPNVIMM",+PXCETEXT=2 D S:PXCEINT="" PXCEINT="^" S PXCEEXT=PXCEINT
. . N CNT,NIEN S (CNT,NIEN)=0 F S NIEN=$O(^AUPNVIMM(IEN,2,NIEN)) Q:'+NIEN D
. . . S CNT=CNT+1,$P(PXCEINT,U,CNT)=$P($G(^AUPNVIMM(IEN,2,NIEN,0)),"^")
. ; PX*1*210
. 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 VFILE="^AUPNVIMM",+PXCETEXT=2,+PXCEINT D VIS Q
. I $P(PXCETEXT,"~",6)]"" D Q:PXCEEXT=""
.. S @("PXCEEXT="_$P(PXCETEXT,"~",6)_"("""_$S($P(PXCETEXT,"~",3)=.01:ENTRY($P(PXCETEXT,"~",1)),1:PXCEINT)_""",PXCEDT)")
. E D
.. N PXCEDILF,DIERR,PXCEI
.. S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
.. S PXCEEXT=$S('$D(DIERR):PXCEEXT,1:PXCEINT)
. ; get ICD info for multiple diagnosis ; ajb
. I VFILE="^AUPNVIMM",+PXCETEXT=3,+PXCEINT D ; ajb
. . S PXCEEXT="" ; ajb
. . N CNT F CNT=1:1:$L(PXCEINT,U) S $P(PXCEEXT,U,CNT)=$$DISPLY01^PXCEPOV($P(PXCEINT,U,CNT),PXCEDT) ; ajb
. N TEMP S TEMP=PXCEEXT
. 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
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
VIS ; get vaccine information statement info ; adm
S PXCEEXT=""
N CNT F CNT=1:1:$L(PXCEINT,U) S $P(PXCEEXT,U,CNT)=$$DISPVIS^PXCEVIS($P(PXCEINT,U,CNT))
N TEMP S TEMP=PXCEEXT
N PXI F PXI=1:1 Q:$P(TEMP,"^",PXI)="" S PXCEEXT=$P(TEMP,"^",PXI) D ADDLINE S:+$D(TMPTXT) PXCETEXT=TMPTXT
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCEAE1 5032 printed Apr 09, 2024@21:32:08 Page 2
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
+2 ;; ;
+3 QUIT
+4 ;
BUILD(VISITIEN,AEVIEW,ARRAY,ARRAYIX) ;
+1 ;AEVIEW is "B" for brief display and "D" for expanded display.
+2 IF '$DATA(^AUPNVSIT(VISITIEN))
SET VALMBCK="Q"
QUIT
+3 NEW PXCECNT
+4 DO FULL^VALM1
+5 DO CLEAN^VALM10
+6 KILL @ARRAYIX
+7 SET (VALMCNT,PXCECNT)=0
+8 ;
+9 ;
+10 NEW IEN,FILE,VFILE,VROUTINE
+11 ; PX*1*215
FOR FILE="SIT","CSTP","PRV","POV","CPT","TRT","IMM","PED","SK","HF","XAM","ICR","SC"
Begin DoDot:1
+12 SET VROUTINE="PXCE"_$SELECT(FILE="IMM":"VIMM",1:FILE)
+13 SET VFILE=$PIECE($TEXT(FORMAT^@VROUTINE),"~",5)
+14 IF FILE="SIT"
Begin DoDot:2
+15 SET IEN=VISITIEN
+16 DO AFILE(IEN,FILE,VFILE,VROUTINE,ARRAY,ARRAYIX,.VALMCNT,.PXCECNT,AEVIEW)
+17 SET VALMCNT=VALMCNT+1
+18 SET @ARRAY@(VALMCNT,0)=""
End DoDot:2
+19 IF '$TEST
Begin DoDot:2
+20 SET IEN=""
+21 FOR
SET IEN=$ORDER(@VFILE@("AD",VISITIEN,IEN))
if 'IEN
QUIT
DO AFILE(IEN,FILE,VFILE,VROUTINE,ARRAY,ARRAYIX,.VALMCNT,.PXCECNT,AEVIEW)
End DoDot:2
End DoDot:1
+22 SET @ARRAYIX@(0)=PXCECNT
+23 IF VALMCNT=0
SET VALMBCK="Q"
+24 QUIT
+25 ;
AFILE(IEN,FILE,VFILE,VROUTINE,ARRAY,ARRAYIX,VALMCNT,PXCECNT,AEVIEW) ;
+1 NEW ENTRY,NODE,NODES,NODECNT,PNARR
+2 SET PXCECNT=PXCECNT+1
+3 SET NODES=$PIECE($TEXT(FORMAT^@VROUTINE),"~",3)
+4 FOR NODECNT=1:1
SET NODE=$PIECE(NODES,",",NODECNT)
if NODE']""
QUIT
SET ENTRY(NODE)=$GET(@VFILE@(IEN,NODE))
+5 ;Check for bad provider narratives.
+6 IF FILE="CPT"
Begin DoDot:1
+7 SET PNARR=$PIECE(ENTRY(0),U,4)
+8 IF PNARR'>0
DO ONEVCPT^PXPNARR(VISITIEN,IEN,.ENTRY)
End DoDot:1
+9 IF FILE="POV"
Begin DoDot:1
+10 SET PNARR=$PIECE(ENTRY(0),U,4)
+11 IF PNARR'>0
DO ONEVPOV^PXPNARR(VISITIEN,IEN,.ENTRY)
End DoDot:1
+12 DO DISPLAY(.ENTRY,VROUTINE,ARRAY,ARRAYIX,.VALMCNT,PXCECNT,AEVIEW)
+13 IF FILE="SIT"
SET @ARRAYIX@(PXCECNT)=VISITIEN_"^VST"
+14 IF '$TEST
SET @ARRAYIX@(PXCECNT)=IEN_"^"_FILE
+15 QUIT
+16 ;
DISPLAY(ENTRY,PXCECODE,ARRAY,ARRAYIX,LINE,COUNT,VIEW) ; -- display the data
+1 NEW PXCEDT,PXCEINT,PXCEEXT,PXCEFILE,PXCELINE,PXCETEXT
+2 SET PXCEFILE=$PIECE($TEXT(FORMAT^@PXCECODE),"~",2)
+3 ;Set the date and time to the Event Date and Time, if it exists,
+4 ;otherwise set it to the Visit Date and Time.
+5 SET PXCEDT=$PIECE($GET(ENTRY(12)),U,1)
+6 IF PXCEDT=""
SET PXCEDT=$PIECE(^AUPNVSIT(PXCEVIEN,0),U,1)
+7 FOR PXCELINE=1:1
SET PXCETEXT=$PIECE($TEXT(FORMAT+PXCELINE^@PXCECODE),";;",2)
if PXCETEXT']""
QUIT
Begin DoDot:1
+8 ; save original PXCETEXT for multiple diagnosis ouput ; ajb
+9 ; ajb
IF VFILE="^AUPNVIMM"
IF +PXCETEXT=3
NEW TMPTXT
SET TMPTXT=PXCETEXT
+10 ; PX*1*210
IF VFILE="^AUPNVIMM"
IF +PXCETEXT=2
NEW TMPTXT
SET TMPTXT=PXCETEXT
+11 SET (PXCEEXT,PXCEINT)=$PIECE(ENTRY($PIECE(PXCETEXT,"~",1)),"^",$PIECE(PXCETEXT,"~",2))
+12 ; get entries from diagnosis multiple ; ajb
+13 ; ajb
IF VFILE="^AUPNVIMM"
IF +PXCETEXT=3
Begin DoDot:2
+14 ; ajb
NEW CNT,NIEN
SET (CNT,NIEN)=0
FOR
SET NIEN=$ORDER(^AUPNVIMM(IEN,3,NIEN))
if '+NIEN
QUIT
Begin DoDot:3
+15 ; ajb
SET CNT=CNT+1
SET $PIECE(PXCEINT,U,CNT)=$GET(^AUPNVIMM(IEN,3,NIEN,0))
End DoDot:3
End DoDot:2
if PXCEINT=""
SET PXCEINT="^"
SET PXCEEXT=PXCEINT
+16 ; ajb - above / PX*1*210 - below
+17 ; get entries from vis offered/given to patient multiple ; PX*1*210
+18 IF VFILE="^AUPNVIMM"
IF +PXCETEXT=2
Begin DoDot:2
+19 NEW CNT,NIEN
SET (CNT,NIEN)=0
FOR
SET NIEN=$ORDER(^AUPNVIMM(IEN,2,NIEN))
if '+NIEN
QUIT
Begin DoDot:3
+20 SET CNT=CNT+1
SET $PIECE(PXCEINT,U,CNT)=$PIECE($GET(^AUPNVIMM(IEN,2,NIEN,0)),"^")
End DoDot:3
End DoDot:2
if PXCEINT=""
SET PXCEINT="^"
SET PXCEEXT=PXCEINT
+21 ; PX*1*210
+22 ;Q:PXCEINT=""
IF PXCETEXT'["CPT Modifier"
IF PXCEINT=""
QUIT
+23 if $PIECE(PXCETEXT,"~",10)="N"
QUIT
+24 IF VIEW'="D"
IF $PIECE(PXCETEXT,"~",10)="D"
QUIT
+25 IF PXCECODE="PXCECSTP"
IF $PIECE(PXCETEXT,"~",3)=.01
QUIT
+26 IF VFILE="^AUPNVIMM"
IF +PXCETEXT=2
IF +PXCEINT
DO VIS
QUIT
+27 IF $PIECE(PXCETEXT,"~",6)]""
Begin DoDot:2
+28 SET @("PXCEEXT="_$PIECE(PXCETEXT,"~",6)_"("""_$SELECT($PIECE(PXCETEXT,"~",3)=.01:ENTRY($PIECE(PXCETEXT,"~",1)),1:PXCEINT)_""",PXCEDT)")
End DoDot:2
if PXCEEXT=""
QUIT
+29 IF '$TEST
Begin DoDot:2
+30 NEW PXCEDILF,DIERR,PXCEI
+31 SET PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$PIECE(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
+32 SET PXCEEXT=$SELECT('$DATA(DIERR):PXCEEXT,1:PXCEINT)
End DoDot:2
+33 ; get ICD info for multiple diagnosis ; ajb
+34 ; ajb
IF VFILE="^AUPNVIMM"
IF +PXCETEXT=3
IF +PXCEINT
Begin DoDot:2
+35 ; ajb
SET PXCEEXT=""
+36 ; ajb
NEW CNT
FOR CNT=1:1:$LENGTH(PXCEINT,U)
SET $PIECE(PXCEEXT,U,CNT)=$$DISPLY01^PXCEPOV($PIECE(PXCEINT,U,CNT),PXCEDT)
End DoDot:2
+37 NEW TEMP
SET TEMP=PXCEEXT
+38 ; replace modified with original for multiple diagnosis ; ajb
NEW PXI
FOR PXI=1:1
if $PIECE(TEMP,"^",PXI)=""
QUIT
SET PXCEEXT=$PIECE(TEMP,"^",PXI)
DO ADDLINE
if +$DATA(TMPTXT)
SET PXCETEXT=TMPTXT
End DoDot:1
+39 QUIT
ADDLINE ;
+1 SET LINE=LINE+1
+2 IF PXCELINE=1!(PXCECODE="PXCECSTP")
SET @ARRAY@(LINE,0)=$JUSTIFY(COUNT,3)_" "
+3 IF '$TEST
SET @ARRAY@(LINE,0)=" "
+4 SET @ARRAY@(LINE,0)=@ARRAY@(LINE,0)_$PIECE(PXCETEXT,"~",5)
+5 IF ($LENGTH(@ARRAY@(LINE,0))+$LENGTH(PXCEEXT))'>80
Begin DoDot:1
+6 SET @ARRAY@(LINE,0)=@ARRAY@(LINE,0)_PXCEEXT
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 NEW PXCEWRAP,PXCECOUN,PXCEHEAD
+9 SET PXCEHEAD=$LENGTH(@ARRAY@(LINE,0))
+10 DO WRAP^PXCEVFI4(PXCEEXT,80-PXCEHEAD,.PXCEWRAP)
+11 SET @ARRAY@(LINE,0)=@ARRAY@(LINE,0)_$GET(PXCEWRAP(1))
+12 SET PXCECOUN=1
+13 FOR
SET PXCECOUN=$ORDER(PXCEWRAP(PXCECOUN))
if PXCECOUN']""
QUIT
Begin DoDot:2
+14 SET LINE=LINE+1
+15 SET @ARRAY@(LINE,0)=$JUSTIFY("",PXCEHEAD)_PXCEWRAP(PXCECOUN)
End DoDot:2
End DoDot:1
+16 QUIT
VIS ; get vaccine information statement info ; adm
+1 SET PXCEEXT=""
+2 NEW CNT
FOR CNT=1:1:$LENGTH(PXCEINT,U)
SET $PIECE(PXCEEXT,U,CNT)=$$DISPVIS^PXCEVIS($PIECE(PXCEINT,U,CNT))
+3 NEW TEMP
SET TEMP=PXCEEXT
+4 NEW PXI
FOR PXI=1:1
if $PIECE(TEMP,"^",PXI)=""
QUIT
SET PXCEEXT=$PIECE(TEMP,"^",PXI)
DO ADDLINE
if +$DATA(TMPTXT)
SET PXCETEXT=TMPTXT
+5 QUIT
+6 ;
