- 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 Feb 18, 2025@23:09:07 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