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

PXBUTL2.m

Go to the documentation of this file.
  1. PXBUTL2 ;ISL/DCM - PCE Utilities ;5/21/96 12:15
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**121,199**;Aug 12, 1996;Build 51
  1. ;
  1. ;
  1. ;
  1. ;
  1. PRV(CLINIC) ;Get default provider and all providers associated with a clinic
  1. ;CLINIC - ifn of clinic in file 44
  1. ;External references: ^SC(DA(1),"PR",DA)
  1. ; ^VA(200,DA,0)
  1. Q:'$G(CLINIC) Q:'$O(^SC(CLINIC,"PR",0))
  1. K PXBPMT N IFN,X,NAME
  1. S IFN=0 F S IFN=$O(^SC(CLINIC,"PR",IFN)) Q:IFN<1 S X=^(IFN,0) D
  1. . S NAME=$P($G(^VA(200,+X,0)),"^") I $L(NAME) S PXBPMT("PRV",NAME,+X)="" S:$P(X,"^",2) PXBPMT("DEF",NAME,+X)=""
  1. Q
  1. POV(CLINIC,CODE) ;Get default diagnosis and all diagnosis associated with clinic
  1. ;CLINIC - ifn of clinic in file 44
  1. ;CODE - 1 (default) code, 2 diagnosis, 3 both
  1. ;External references: ^SC(DA(1),"DX",DA)
  1. ; ^ICD9(DA,0)
  1. Q:'$G(CLINIC) Q:'$O(^SC(CLINIC,"DX",0))
  1. K PXBPMT
  1. N IFN,NAME,PXDXDATE,X
  1. S PXDXDATE=$$CSDATE^PXDXUTL(PXBVST)
  1. S:'$D(CODE) CODE=1
  1. S IFN=0 F S IFN=$O(^SC(CLINIC,"DX",IFN)) Q:IFN<1 S X=^(IFN,0) D
  1. . S NAME=$P($$ICDDATA^ICDXCODE("DIAG",+X,PXDXDATE,"I"),"^",2,4)
  1. . I $P(NAME," ",1,2)="Invalid Code" S NAME="" ; ignore value if Invalid Code message is returned from $$ICDDATA
  1. . ;jvs 7/22/96 allow selection of v codes
  1. . I $L(NAME) S NAME=$S(CODE=2:$S($L($P(NAME,"^",3)):$P(NAME,"^",3),1:$P(NAME,"^")),CODE=3:$P(NAME,"^")_"--"_$P(NAME,"^",3),1:$P(NAME,"^")),PXBPMT("POV",NAME,+X)="" S:$P(X,"^",2) PXBPMT("DEF",NAME,+X)=""
  1. Q
  1. TSTPRV ;Test provider lookup
  1. S DIC=44,DIC(0)="AEQLM" D ^DIC Q:Y<1 D PRV(+Y)
  1. K DIC
  1. Q
  1. TSTPOV ;Test diagnosis lookup
  1. S DIC=44,DIC(0)="AEQLM" D ^DIC Q:Y<1 D POV(+Y,3)
  1. K DIC
  1. Q