RGPRPST ;SLC/NCG-CIRN CMOR POPULATE 991.8 ;4-15-1998
;;0.5; CLINICAL INFO RESOURCE NETWORK ;;30 Sep 98
EN ;
D PCC
K RGI,PCC
Q
PCC ;set primary care clinics into 991.8
N PCC,RGI,RGPCC,X,Y
S PCC(1)="PRIMARY CARE/MEDICINE"
S PCC(2)="PRIMARY CARE/SURGERY"
S PCC(3)="GERIATRIC PRIMARY CARE"
D BMES^XPDUTL("Adding Clinics to File 991.8")
F RGI=1:1:3 D
. S RGPCC=+$$FIND1^DIC(40.7,,"OX",PCC(RGI)) I RGPCC>0 D
. . 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
. . K DIE,DIC,DA,DR,D0,DLAYGO
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGPRPST 642 printed Dec 13, 2024@01:42:44 Page 2
RGPRPST ;SLC/NCG-CIRN CMOR POPULATE 991.8 ;4-15-1998
+1 ;;0.5; CLINICAL INFO RESOURCE NETWORK ;;30 Sep 98
EN ;
+1 DO PCC
+2 KILL RGI,PCC
+3 QUIT
PCC ;set primary care clinics into 991.8
+1 NEW PCC,RGI,RGPCC,X,Y
+2 SET PCC(1)="PRIMARY CARE/MEDICINE"
+3 SET PCC(2)="PRIMARY CARE/SURGERY"
+4 SET PCC(3)="GERIATRIC PRIMARY CARE"
+5 DO BMES^XPDUTL("Adding Clinics to File 991.8")
+6 FOR RGI=1:1:3
Begin DoDot:1
+7 SET RGPCC=+$$FIND1^DIC(40.7,,"OX",PCC(RGI))
IF RGPCC>0
Begin DoDot:2
+8 SET DIC("P")=$PIECE(^DD(991.8,17,0),U,2)
SET DIC(0)="ML"
SET DLAYGO=991.817
SET DIC="^RGSITE(991.8,1,""PC"","
SET X=PCC(RGI)
SET DA(1)=1
DO ^DIC
IF +Y>0
SET DA=+Y
SET DA(1)=1
SET DIE=DIC
SET DR="1///2971001"
DO ^DIE
+9 KILL DIE,DIC,DA,DR,D0,DLAYGO
End DoDot:2
End DoDot:1
+10 QUIT
