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 - 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;;Aug 12, 1996
  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. ;