RGPRPST.m

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 ---RGPRPST   642     printed  Apr 09, 2024@20:47:31                                                                                                                                                                                                      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