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

PXCAPRV ;ISL/dee - Translates data from the PCE Device Interface into PCE's PXK for Providers ;3/14/97
 ;;1.0;PCE PATIENT CARE ENCOUNTER;**27**;Aug 12, 1996
 Q
 ;
PROVIDER(PXCAENC) ;Provider
 ; Variables
 ;   PXCAPRV   Pointer to the provider (200)
 ;   PXCAPS    Primary or Secondary provider for above
 ;   PXCAATND  Pointer to the Attending provider (200)
 ;   PXCAFTER  Temp used to build ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,0,"AFTER")
 N PXCAPRV,PXCAPS,PXCAATND,PXCAFTER
 S PXCAPRV=$P(PXCAENC,"^",4)
 S PXCAPS=$P(PXCAENC,"^",15)
 S PXCAATND=$P(PXCAENC,"^",16)
 I PXCAPRV>0 D
 . S PXCAFTER=PXCAPRV_"^"
 . S PXCAFTER=PXCAFTER_PXCAPAT_"^"_PXCAVSIT_"^"
 . S PXCAFTER=PXCAFTER_PXCAPS_"^"
 . I PXCAATND>0 D
 .. I PXCAATND=PXCAPRV S PXCAFTER=PXCAFTER_"A"
 .. E  D ATTEND
 . S PXCANPRV=PXCANPRV+1
 . S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,"IEN")=""
 . S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,0,"BEFORE")=""
 . S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,0,"AFTER")=PXCAFTER
 . S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,812,"BEFORE")=""
 . S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
 E  I PXCAATND>0 D ATTEND
 Q
 ;
ATTEND ;Add the attending provider.
 S PXCANPRV=PXCANPRV+1
 S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,"IEN")=""
 S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,0,"BEFORE")=""
 S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,0,"AFTER")=PXCAATND_"^"_PXCAPAT_"^"_PXCAVSIT_"^S^A"
 S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,812,"BEFORE")=""
 S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
 Q
 ;
ANOTHPRV(PXCAAPRV) ;
 ;Add the provider to V Provider if they are not there.
 ;Quit if the provider subscript is zero
 ; Variables
 ;   PXCAAPRV  Pointer to the provider (200)
 ;   PXCAINDX  Subscirpt of the provider in the temp array used to
 ;               look to see if the above provider is already know.
 Q:PXCAAPRV'>0
 N PXCAINDX
 S PXCAINDX=0
 F PXCAINDX=1:1:PXCANPRV I PXCAAPRV=+^TMP(PXCAGLB,$J,"PRV",PXCAINDX,0,"AFTER") S PXCAINDX=0 Q
 Q:PXCAINDX'>0
 S PXCANPRV=PXCANPRV+1
 S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,"IEN")=""
 S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,0,"BEFORE")=""
 S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,0,"AFTER")=PXCAAPRV_"^"_PXCAPAT_"^"_PXCAVSIT_"^S"
 S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,812,"BEFORE")=""
 S ^TMP(PXCAGLB,$J,"PRV",PXCANPRV,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
 Q
 ;
PRV(PXCAPRV,PXCANPRV,PXCAIEN,PXCAERRS) ;Process the provider nodes
 N PXCAINDX,PXCANEW
 S PXCANEW=1
 F PXCAINDX=1:1:PXCANPRV I PXCAIEN=+^TMP(PXCAGLB,$J,"PRV",PXCAINDX,0,"AFTER") S PXCANEW=0 Q
 I PXCANEW D
 . S (PXCANPRV,PXCAINDX)=PXCANPRV+1
 . S ^TMP(PXCAGLB,$J,"PRV",PXCAINDX,"IEN")=""
 . S ^TMP(PXCAGLB,$J,"PRV",PXCAINDX,0,"BEFORE")=""
 . S ^TMP(PXCAGLB,$J,"PRV",PXCAINDX,0,"AFTER")=PXCAIEN_"^"_PXCAPAT_"^"_PXCAVSIT
 . S ^TMP(PXCAGLB,$J,"PRV",PXCAINDX,812,"BEFORE")=""
 . S ^TMP(PXCAGLB,$J,"PRV",PXCAINDX,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
 S $P(^TMP(PXCAGLB,$J,"PRV",PXCAINDX,0,"AFTER"),"^",4)=$P(PXCAPRV,"^",1)
 S:$P(PXCAPRV,"^",2)]"" $P(^TMP(PXCAGLB,$J,"PRV",PXCAINDX,0,"AFTER"),"^",5)=$S($P(PXCAPRV,"^",2)=1:"A",1:"")
 Q
 ;
PROV(PXCA,PXCABULD,PXCAERRS) ;Validate the provider nodes
 Q:'$D(PXCA("PROVIDER"))
 N PXCAIEN,PXCAPRV,PXCAITEM
 S PXCAIEN=""
 F  S PXCAIEN=$O(PXCA("PROVIDER",PXCAIEN)) Q:PXCAIEN']""  D
 . I '$$ACTIVPRV^PXAPI(PXCAIEN,PXCADT) S PXCA("ERROR","PROVIDER",PXCAIEN,0,0)="Provider is not active or valid^"_PXCAIEN
 . S PXCAPRV=$G(PXCA("PROVIDER",PXCAIEN))
 . S PXCAITEM=$P(PXCAPRV,"^",1)
 . I '(PXCAITEM="P"!(PXCAITEM="S")) S PXCA("ERROR","PROVIDER",PXCAIEN,0,1)="Provider indicator code must be P|S^"_PXCAITEM
 . E  I PXCAITEM="P" D
 .. I 'PXCAPPRV S PXCAPPRV=PXCAIEN
 .. E  I PXCAPPRV'=PXCAIEN D
 ... S PXCA("WARNING","PROVIDER",PXCAIEN,0,1)="There is already a Primary Provider this one is changed to Secondary^"_PXCAITEM
 ... S $P(PXCAPRV,"^",1)="S"
 . S PXCAITEM=$P(PXCAPRV,"^",2)
 . I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROVIDER",PXCAIEN,0,2)="Attending flag bad^"_PXCAITEM
 . I PXCABULD&'$D(PXCA("ERROR","PROVIDER",PXCAIEN))!PXCAERRS D PRV(PXCAPRV,.PXCANPRV,PXCAIEN,PXCAERRS)
 Q
 ;