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

RGPRPST.m

Go to the documentation of this file.
  1. RGPRPST ;SLC/NCG-CIRN CMOR POPULATE 991.8 ;4-15-1998
  1. ;;0.5; CLINICAL INFO RESOURCE NETWORK ;;30 Sep 98
  1. EN ;
  1. D PCC
  1. K RGI,PCC
  1. Q
  1. PCC ;set primary care clinics into 991.8
  1. N PCC,RGI,RGPCC,X,Y
  1. S PCC(1)="PRIMARY CARE/MEDICINE"
  1. S PCC(2)="PRIMARY CARE/SURGERY"
  1. S PCC(3)="GERIATRIC PRIMARY CARE"
  1. D BMES^XPDUTL("Adding Clinics to File 991.8")
  1. F RGI=1:1:3 D
  1. . S RGPCC=+$$FIND1^DIC(40.7,,"OX",PCC(RGI)) I RGPCC>0 D
  1. . . S DIC("P")=$P(^DD(991.8,17,0),U,2),DIC(0)="ML",DLAYGO=991.817,DIC="^RGSITE(991.8,1,""PC"",",X=PCC(RGI),DA(1)=1 D ^DIC I +Y>0 S DA=+Y,DA(1)=1,DIE=DIC,DR="1///2971001" D ^DIE
  1. . . K DIE,DIC,DA,DR,D0,DLAYGO
  1. Q