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

PXRRPRPL.m

Go to the documentation of this file.
  1. PXRRPRPL ;ISL/PKR - Build the Provider list ;01/30/2017
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**10,12,211**;Aug 12, 1996;Build 454
  1. ;Build the Provider list based upon the Provider selection criteria.
  1. ;
  1. ;==========================================
  1. PRV ;Build a list of selected providers.
  1. N X,Y
  1. K DTOUT,DUOUT
  1. S NPL=0
  1. S DIC=200
  1. S DIC(0)="AEQMZ"
  1. S DIC("A")="Select PROVIDER: "
  1. ;As of April 1996 a determination has been made not to use the provider
  1. ;key screen. It has just been commented out because there is a
  1. ;possibility it may be used in the future.
  1. ;S DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P($G(^VA(200,+Y,0)),U)))"
  1. W !
  1. NPRO I NPL'<1 S DIC("A")="Select another PROVIDER: "
  1. D ^DIC
  1. I X=(U_U) S DTOUT=1
  1. I $D(DTOUT) Q
  1. I +Y'=-1 D G NPRO
  1. . S NPL=NPL+1
  1. . S PXRRPRPL(NPL)=$P(Y,U,2)_U_$P(Y,U,1)
  1. E K DIC
  1. I (NPL=0)&($D(DIRUT)!$D(DUOUT)) Q
  1. I $D(DUOUT) G PRV
  1. I (NPL=0)&(+Y=-1) W !,"You must select a provider!" G PRV
  1. ;
  1. ;Sort the provider list into ascending order.
  1. S NPL=$$SORT^PXRRUTIL(NPL,"PXRRPRPL")
  1. Q
  1. ;
  1. ;==========================================
  1. TEAM ;Build a list of selected providers by CPRS Team.
  1. ;DBIA #1489 covers access to file #100.21.
  1. N IEN,PRVDUZ,PRVNAME,X,Y
  1. K DTOUT,DUOUT
  1. S NPL=0
  1. S DIC=100.21
  1. S DIC(0)="AEQMZ"
  1. S DIC("A")="Select CPRS Team (OE/RR List): "
  1. W !
  1. NTEAM I NPL'<1 S DIC("A")="Select another CPRS Team (OE/RR List): "
  1. D ^DIC
  1. I X=(U_U) S DTOUT=1
  1. I $D(DTOUT) Q
  1. I +Y'=-1 D G NTEAM
  1. . S IEN=+$P(Y,U,1)
  1. . I $P($G(^OR(100.21,IEN,1,0)),U,4)'>0 D G NTEAM
  1. .. W !,"There are no providers on this CPRS Team (OE/RR List)!"
  1. . S PRVDUZ=0
  1. . F S PRVDUZ=$O(^OR(100.21,IEN,1,PRVDUZ)) Q:PRVDUZ="" D
  1. .. S PRVNAME=$$GET1^DIQ(200,PRVDUZ,.01)
  1. .. S NPL=NPL+1
  1. .. S PXRRPRPL(NPL)=PRVNAME_U_PRVDUZ
  1. E K DIC
  1. I (NPL=0)&($D(DIRUT)!$D(DUOUT)) Q
  1. I $D(DUOUT) G TEAM
  1. I (NPL=0)&(+Y=-1) W !,"You must select a CPRS Team (OE/RR List)!" G TEAM
  1. ;
  1. ;Sort the provider list into ascending order.
  1. S NPL=$$SORT^PXRRUTIL(NPL,"PXRRPRPL")
  1. Q
  1. ;