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

PXCEVFI4.m

Go to the documentation of this file.
  1. PXCEVFI4 ;ISL/dee,SLC/ajb - Routine to display a visit or v-file entry and input providers in to V PROVIDER from other V Files ;6/20/96
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**124,203,199,201**;Aug 12, 1996;Build 41
  1. Q
  1. DISPLAY ; -- display the data
  1. Q:PXCECAT="CSTP"
  1. N PXCELINE,PXCETEXT,PXCEINT,PXCEEXT
  1. I PXCECAT="APPM"!(PXCECAT="HIST") N PXCECODE S PXCECODE="PXCESIT"
  1. W !
  1. F PXCELINE=1:1 S PXCETEXT=$P($T(FORMAT+PXCELINE^@PXCECODE),";;",2) Q:PXCETEXT']"" D
  1. . S (PXCEINT,PXCEEXT)=$P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))
  1. . I PXCEINT="@" S PXCEEXT="<deleted>"
  1. . E I PXCEINT'="" D
  1. .. I $P(PXCETEXT,"~",6)]"" S @("PXCEEXT="_$P(PXCETEXT,"~",6)_"("""_PXCEINT_""")")
  1. .. E D
  1. ... N DIERR,PXCEDILF
  1. ... S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
  1. ... S PXCEEXT=$S('$D(DIERR):PXCEEXT,1:PXCEINT)
  1. . I ($L($P(PXCETEXT,"~",5))+$L(PXCEEXT))'>80 D
  1. .. W !,$P(PXCETEXT,"~",5),PXCEEXT
  1. . E D
  1. .. N PXCEWRAP,PXCECOUN
  1. .. D WRAP(PXCEEXT,80-$L($P(PXCETEXT,"~",5)),.PXCEWRAP)
  1. .. W !,$P(PXCETEXT,"~",5),$G(PXCEWRAP(1))
  1. .. S PXCECOUN=1
  1. .. F S PXCECOUN=$O(PXCEWRAP(PXCECOUN)) Q:PXCECOUN']"" D
  1. ... W !,$J("",$L($P(PXCETEXT,"~",5))),PXCEWRAP(PXCECOUN)
  1. Q
  1. ;
  1. WRAP(X,DIWR,WRAPPED) ;Copies the text in X into the array WRAPPED
  1. N DIWL,DIWF,PXCEINDX
  1. K ^UTILITY($J,"W")
  1. S DIWL=1
  1. S DIRF=""
  1. D ^DIWP
  1. S PXCEINDX=0
  1. F S PXCEINDX=$O(^UTILITY($J,"W",DIWL,PXCEINDX)) Q:'PXCEINDX S WRAPPED(PXCEINDX)=^UTILITY($J,"W",DIWL,PXCEINDX,0)
  1. K ^UTILITY($J,"W")
  1. Q
  1. ;
  1. PROVIDER(PXCEPRV) ;See if it is a new provider and if it is add them.
  1. N PXCEVPRV,PXCEKPRV,PXCENPRV,PXCEPRIM
  1. N DIR,DA,X,Y
  1. S (PXCEVPRV,PXCEKPRV)=""
  1. S PXCEPRIM=0
  1. ;See if this provider is already in V Provider for this Encounter
  1. F S PXCEVPRV=$O(^AUPNVPRV("AD",PXCEVIEN,PXCEVPRV)) Q:PXCEVPRV'>0 Q:PXCEPRV=$P(^AUPNVPRV(PXCEVPRV,0),"^",1) S:"P"=$P(^AUPNVPRV(PXCEVPRV,0),"^",4) PXCEPRIM=1
  1. Q:PXCEVPRV>0
  1. ;See if this provider is in the ^TMP("PXK",$J,
  1. F S PXCEKPRV=$O(^TMP("PXK",$J,"PRV",PXCEKPRV)) Q:PXCEKPRV'>0 Q:PXCEPRV=+^TMP("PXK",$J,"PRV",PXCEKPRV,0,"AFTER") S:"P"=$P(^TMP("PXK",$J,"PRV",PXCEKPRV,0,"AFTER"),"^",4) PXCEPRIM=1
  1. Q:PXCEKPRV>0
  1. I 'PXCEPRIM D I $D(DTOUT)!$D(DUOUT) Q
  1. . N DIR,DA
  1. . S DIR(0)="9000010.06,.04A"
  1. . S DIR("A")="Is this provider Primary or Secondary? "
  1. . S DIR("B")=$S(PXCEPRIM:"S",1:"P")
  1. . D ^DIR
  1. I PXCEPRIM S Y="S"
  1. ;Set PXCENPRV to the next provider in ^TMP("PXK",$J,"PRV",
  1. I $Q(^TMP("PXK",$J,"PRV"))["PXK,"_$J_",PRV" S PXCENPRV=+$O(^TMP("PXK",$J,"PRV",""),-1)+1
  1. E S PXCENPRV=1
  1. S ^TMP("PXK",$J,"PRV",PXCENPRV,"IEN")=""
  1. S ^TMP("PXK",$J,"PRV",PXCENPRV,0,"BEFORE")=""
  1. S ^TMP("PXK",$J,"PRV",PXCENPRV,0,"AFTER")=PXCEPRV_"^"_PXCEPAT_"^"_PXCEVIEN_"^"_$P(Y,"^")
  1. S ^TMP("PXK",$J,"PRV",PXCENPRV,812,"BEFORE")=""
  1. S ^TMP("PXK",$J,"PRV",PXCENPRV,812,"AFTER")="^"_PXCEPKG_"^"_PXCESOR
  1. Q
  1. ;
  1. DIAGNOS(PXCEPOV,OTHER) ;See if it is a new diagnosis and if it is add them. ; added OTHER ; ajb
  1. N DA,DIR,PXCEDXSC,PXCEKPOV,PXCEMOD,PXCENARR,PXCENPOV,PXCEPMSC,PXCEVDT
  1. N PXCEVPOV,PXCEX,PXCEY,X,Y
  1. S (PXCEVPOV,PXCEKPOV)=""
  1. S PXCEPRIM=$S(+$G(OTHER):0,1:1) S:+PXCEPRIM PXCEPMSC="P" ; set as primary diagnosis unless OTHER DIAGNOSIS is indicated
  1. ;See if this diagnosis is already in V POV for this Encounter
  1. F S PXCEVPOV=$O(^AUPNVPOV("AD",PXCEVIEN,PXCEVPOV)) Q:PXCEVPOV'>0 Q:PXCEPOV=$P(^AUPNVPOV(PXCEVPOV,0),"^",1) S:"P"=$P(^AUPNVPOV(PXCEVPOV,0),"^",12) PXCEPRIM=1
  1. Q:PXCEVPOV>0
  1. ;See if this diagnosis is in the ^TMP("PXK",$J,
  1. F S PXCEKPOV=$O(^TMP("PXK",$J,"POV",PXCEKPOV)) Q:PXCEKPOV'>0 Q:PXCEPOV=+^TMP("PXK",$J,"POV",PXCEKPOV,0,"AFTER") S:"P"=$P(^TMP("PXK",$J,"POV",PXCEKPOV,0,"AFTER"),"^",12) PXCEPRIM=1
  1. Q:PXCEKPOV>0
  1. ;Is this diagnosis primary P/S
  1. I 'PXCEPRIM,'+$G(OTHER) D I $D(DTOUT)!$D(DUOUT) S PXCEEND=1,PXCEQUIT=1 Q ; check if OTHER
  1. . N DIR,DA
  1. . S DIR(0)="9000010.07,.12A"
  1. . S DIR("A")="Diagnosis is Primary? "
  1. . S DIR("B")="P"
  1. . D ^DIR
  1. . S PXCEPMSC=$P(Y,"^",1)
  1. . S:PXCEPMSC="P" PXCEPRIM=1
  1. S:'$D(PXCEPMSC) PXCEPMSC="S"
  1. ;Diagnosis narrative
  1. D I $D(DTOUT)!$D(DUOUT) S PXCEEND=1,PXCEQUIT=1 Q
  1. . N DIR,DA
  1. . S DIR(0)="9000010.07,.04AO"
  1. . S DIR("A")="Provider Narrative: "
  1. . D ^DIR
  1. S PXCEX=Y
  1. I PXCEX="" D
  1. . S PXCEVDT=$$CSDATE^PXDXUTL(PXCEVIEN) ; get visit date
  1. . S PXCEX=$$DXNARR^PXUTL1(+PXCEPOV,PXCEVDT) ; get diagnosis description
  1. W !,PXCEX
  1. S PXCEY=$$PROVNARR^PXAPI(PXCEX,9000010.07) I +PXCEY'>0 W "??",$C(7) S PXCEEND=1,PXCEQUIT=1 Q
  1. S PXCENARR=$P(PXCEY,"^",1)
  1. ;Diagnosis modifier
  1. D I $D(DTOUT)!$D(DUOUT) S PXCEEND=1,PXCEQUIT=1 Q
  1. . N DIR,DA
  1. . S DIR(0)="9000010.07,.06A"
  1. . S DIR("A")="Diagnosis Modifier: "
  1. . D ^DIR
  1. S PXCEMOD=$P(Y,U,2)
  1. ;Diagnosis Service Connected, Clinical Indicators
  1. D GET800^PXCED800
  1. ;Set PXCENPOV to the next diagnosis in ^TMP("PXK",$J,"POV",
  1. I $Q(^TMP("PXK",$J,"POV"))["PXK,"_$J_",POV" S PXCENPOV=+$O(^TMP("PXK",$J,"POV",""),-1)+1
  1. E S PXCENPOV=1
  1. S ^TMP("PXK",$J,"POV",PXCENPOV,"IEN")=""
  1. S ^TMP("PXK",$J,"POV",PXCENPOV,0,"BEFORE")=""
  1. S ^TMP("PXK",$J,"POV",PXCENPOV,0,"AFTER")=PXCEPOV_"^"_PXCEPAT_"^"_PXCEVIEN_"^"_PXCENARR_"^^"_PXCEMOD_"^^^^^^"_PXCEPMSC
  1. S ^TMP("PXK",$J,"POV",PXCENPOV,800,"BEFORE")=""
  1. S ^TMP("PXK",$J,"POV",PXCENPOV,800,"AFTER")=PXCEDXSC
  1. S ^TMP("PXK",$J,"POV",PXCENPOV,812,"BEFORE")=""
  1. S ^TMP("PXK",$J,"POV",PXCENPOV,812,"AFTER")="^"_PXCEPKG_"^"_PXCESOR
  1. Q
  1. ;
  1. ;